home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d123456 / STR_BIT.ZIP / 16 / STRBIT16.PAS < prev    next >
Pascal/Delphi Source File  |  2002-06-11  |  55KB  |  1,423 lines
  1. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  2. {              ÄüÜàèÆ üêÆÄéǃ æÆÉÄèÇ                          }
  3. {   éÑpß¿∩ 3.0.                                               }
  4. {   ä½∩ »p«úpá¼¼   ¡á ÆôÉüÄ-ÅÇæèÇïà  V 6.0  ¿ óδΦÑ            }
  5. {   ñ½∩ Σπ¡¬µ¿«¡¿α«óá¡¿∩ ¡Ñ«íσ«ñ¿¼ »α«µÑßß«α 8088 ¿ óδΦÑ      }
  6. {  páºpáí«Γτ¿¬ æѼѡ«ó é∩τÑß½áó ï∞ó«ó¿τ                       }
  7. {____________________________________________1999 ú.__________}
  8. {   ö«p¼áΓ »pÑñßΓáó½Ñ¡¿∩ ¼áßß¿óá, ß«ñÑpªáΘÑú« í¿Γ«óδÑ ßΓp«¬¿: }
  9. {   íá⌐Γ :  76543210          - ¡π¼Ñpᵿ∩ í¿Γ ó íá⌐ΓÑ         }
  10. {   ß½«ó«:  111111                                            }
  11. {           5432109876543210  - ¡π¼Ñpᵿ∩ í¿Γ ó ß½«óÑ         }
  12. {   ¼áßß¿ó:         111111  22221111 ...  - ¡π¼Ñpᵿ∩ í¿Γ     }
  13. {           765432105432109832109876 ...    ó ¼áßß¿óÑ         }
  14. {           ! 1íá⌐Γ ! 2 íá⌐Γ! 3 íá⌐Γ!                         }
  15. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  16. unit StrBit16;
  17. {$F+,R+,X+,B+,V-}
  18. interface
  19. const
  20.    bt1 : byte = 1;     { "1" í¿Γ              }
  21.    bt0 : byte = 0;     { "0" í¿Γ              }
  22.   btCreate   : word =  $3C00; { ßΓp«¬á í¿Γ,ßó∩ºá¡á ß ºá»¿ß∞ε ó Σá⌐½ }
  23.   btOpenRead : word =  $3D00; {ßΓp«¬á í¿Γ,ßó∩ºá¡á ß τΓÑ¡¿Ñ¼ ¿º Σá⌐½á}
  24.    btAND : byte = $22;   { «»Ñpᵿ∩ AND         }
  25.    btXOR : byte = $32;   { «»Ñpᵿ∩ XOR         }
  26.    btOR  : byte = $0A;   { «»Ñpᵿ∩ OR          }
  27.    Error_Str_bit : integer = 0;
  28.    Error_File_bit : integer = 0;
  29.  { ÅÑpѼѡ¡á∩ »p¿¡¿¼áÑΓ º¡áτÑ¡¿∩, 1 - 3 Γ«½∞¬« »p¿             }
  30.  { ó¬½ετÑ¡¡«¼ ¬«¡Γp«½Ñ óδσ«ñá ºá úpá¡¿µδ (pѪ¿¼ ¬«¼»¿½∩µ¿¿ R+) }
  31.    btOk      = 0; { ¡Ñ í佫 «Φ¿í«¬            }
  32.    btGran    = 7; { »«»δΓ¬á óδσ«ñá ºá óÑpσ¡εε úpá¡¿µπ ßΓ«p¬¿  }
  33.    btNeop    = 2; { »«»δΓ¬á »ÑpÑß½áΓ∞ ¡Ñ«»pÑñѽѡ¡δÑ í¿Γδ     }
  34.    btDlst    = 3; { ßΓp«¬á «»Ñpᵿ¿ ñ½¿¡¡ÑÑ ΓѬπΘÑ⌐ ßΓp«¬¿    }
  35.    btNevReg  = 4; { ìÑóÑp¡δ⌐ ºá»p«ß      }
  36.    btOchBB   = 5; { ÄΦ¿í¬á »p¿ óδ»-¿¿ éó«ñá/óδó«ñá ñá¡¡¡δσ }
  37.    btErrOtkr = 6; { ÄΦ¿í¬á »α¿ «Γ¬αδΓ¿¿ í¿Γ«ó«ú« Σá⌐½á     }
  38.    btNotFound = $FFFF; { »«ñßΓp«¬á ¡Ñ ¡á⌐ñÑ¡á }
  39.    btEndFile =  9;     { è«¡Ñµ ñá¡¡δσ ó Σá⌐½Ñ }
  40.  
  41. type
  42.   PStr_Bit = ^TStr_Bit;
  43.   TStr_Bit = object
  44.    dlina     : word;    { ÆѬπΘá∩ ñ½¿¡á í¿Γ«ó«⌐ ßΓp«¬¿       }
  45.    Max_dlina : word;    { îá¬ß¿¼á½∞¡á∩ ñ½¿¡á í¿Γ«ó«⌐ ßΓp«¬¿  }
  46.    razmer    : integer; { ÉẼÑp í¿Γ«ó«⌐ ßΓp«¬¿ ó íá⌐Γáσ     }
  47.    Pmas      : pointer; { ô¬áºáΓѽ∞ ¡á ¼áßß¿ó í¿Γ            }
  48.  
  49.     constructor Init(ASizeMax: Word);
  50.   { ASizeMax - ¼á¬ß¿¼á½∞¡á∩ ñ½¿¡á ßΓp«¬¿ ó í¿Γáσ }
  51.     destructor Done;
  52.   function Length: word; { é«ºópáΘáÑΓ ΓѬπΘπε ñ½¿¡π ßΓp«¬¿   }
  53.   function Pos(SubS: PStr_bit; Nach, Shag : word ): word;
  54.    { é«ºópáΘáÑΓ »«º¿µ¿ε, ¡áτ¿¡á∩ ß ¬«Γ«p«⌐ ó ΓѬπΘÑ⌐ ßΓp«¬Ñ  }
  55.    { páß»«½áúáÑΓß∩ »«ñßΓp«¬á SubS;                           }
  56.    { Å«¿ß¬ ¡áτ¿¡áÑΓß∩ ß í¿Γá Nach, óßÑ »«ß½ÑñπεΘ¿Ñ ßpáó¡Ñ¡¿∩ }
  57.    { óδ»«½¡∩εΓß∩ ¿º¼Ñ¡Ñ¡¿Ñ¼ ¿ßσ«ñ¡«⌐ »«º¿µ¿¿ ß Φáú«¼ Shag    }
  58.    { btNotFound = $FFFF  - »«ñßΓp«¬á ¡Ñ ¡á⌐ñÑ¡á              }
  59.   function GetBit(Nach:word): byte;
  60.    { é«ºópáΘáÑΓ º¡áτÑ¡¿Ñ í¿Γá ΓѬπΘÑ⌐ ßΓp«¬¿ ¡á »«º¿µ¿¿ Nach }
  61.    { bt1 - ¡á ñá¡¡«⌐ »«º¿µ¿¿ 1                               }
  62.    { bt0 - ¡á ñá¡¡«⌐ »«º¿µ¿¿ 0                               }
  63.   function Kol_ed : word;
  64.    { Åp«µÑñπpá »«ñßτ¿ΓδóáÑΓ ¬«½¿τÑßΓó« 1 í¿Γ ó í¿Γ«ó«⌐ ßΓ᫬Ñ}
  65.   function ModReg( VidReg : PStr_bit ; Nbis : word) : byte;
  66. { öπ¡¬µ¿∩ ¼«ñѽ¿pπÑΓ ßπ¼¼¿p«óá¡¿Ñ »« mod 2 »« «Γó«ñá¼ pÑú¿ßΓpá VidReg,
  67.  ºáñá¡¡δ¼ í¿Γ«ó«⌐ ßΓp«¬«⌐. æπ¼¼¿p«óá¡¿Ñ ¡áτ¿¡áÑΓß∩ ß í¿Γá NBIS ¡á
  68.  ΓѬπΘÑ⌐ í¿Γ«ó«⌐ ßΓp«¬Ñ. ÉѺπ½∞ΓáΓ páí«Γδ Σπ¡¬µ¿¿ páóÑ¡ bt1 ¿½¿ bt0  }
  69.   function Nomer(Nach : word; dln: byte) : word;
  70.  { öπ¡¬µ¿∩ óδñѽ∩ÑΓ c½«ó« ß í¿Γá N    }
  71.  { é ß½«óÑ ºá»«½¡Ñ¡δ DLN ¼½áñΦ¿σ í¿Γ  }
  72.   function Val_Mas(var Mas; Kol: word) : word;
  73.  { ôßΓá¡áó½¿óáÑΓ Kol íá⌐Γ ¼áßß¿óá Mas ó ß«ßΓ«∩¡¿∩ bt1 ¿½¿ bt0,     }
  74.  { «»pÑñѽ∩ѼδÑ ΓѬπΘÑ⌐ ßΓp«¬«⌐ í¿Γ (pá߻ᬫóá¡¡δ⌐ óáp¿á¡Γ ßΓp«¬¿) }
  75.  { ¬«½¿τÑßΓó« »«½πτÑ¡¡δσ φ½Ñ¼Ñ¡Γ«ó óδñáÑΓß∩ ó ¬áτÑßΓóÑ pѺ-Γá      }
  76.   function Val_sim(Kol:byte): string;
  77.    { ÅpÑ«ípáºπÑΓ »ÑpóδÑ KOL í¿Γ«ó ßΓp«¬¿ ¬ ß¿¼ó½∞¡«¼π ó¿ñπ   }
  78.   procedure Bool_op (StrBaz, Dop: PStr_bit; Index, Vid_op: word);
  79.  { éδ»«½¡∩ÑΓ ß½«ªÑ¡¿Ñ í¿Γ ßΓp«¬¿ StrBaz, ¡áτ¿¡á∩ ß »«º¿µ¿¿ Index       }
  80.  { ß« ßΓp«¬«⌐ Dop »« »páó¿½á¼ íπ½Ñó«⌐ á½úÑípδ, «»pÑñѽ∩Ñ¼δ¼ »ápá¼ÑΓα«¼ }
  81.  { Vid_op, pѺπ½∞ΓáΓ ºá»¿ßδóáÑΓß∩ ó ΓѬπΘπε í¿Γ«óπε ßΓp«¬π.            }
  82.   procedure InvStrBit;
  83.  { ê¡óÑαΓ¿απÑΓ í¿Γ«óπε »«ß½Ññ«óáΓѽ∞¡«ßΓ∞. èáªñá∩ "1" ßΓá¡«ó¿Γß∩ "0" ¿ ¡á«í«α«Γ }
  84.   procedure Concat ( Dopoln : PStr_bit);
  85.    { éδ»«½¡∩ÑΓ ß½¿∩¡¿Ñ ΓѬπΘÑ⌐ ßΓp«¬¿ ß« ßΓp«¬«⌐ Dopoln      }
  86.   procedure BitDisplase (Zn: byte);
  87.  { ÄßπΘÑßΓó½∩ÑΓ óßΓáó¬π í¿Γá Zn ó ¡π½Ñóπε »«º¿µ¿ε í¿Γ«ó«⌐ »«ß½Ññ-Γ¿ }
  88.  { ( óßÑ «ßΓá½∞¡δÑ í¿Γδ »«ß½Ññ«óáΓѽ∞¡«ßΓ¿ ßñó¿úáεΓß∩ ¡á 1 í¿Γ )    }
  89.  { »«ß½Ññ¡¿⌐ í¿Γ »«ß½Ññ«óáΓѽ∞¡«ßΓ¿ πñá½∩ÑΓß∩                       }
  90.  { ( «»Ñαᵿ∩ ¡Ñ ¿º¼Ñ¡∩ÑΓ αẼÑα «íαáíáΓδóáѼ«⌐ í¿Γ«ó«⌐ ßΓ᫬¿ )    }
  91.   procedure LastBitDisplase (Zn: byte);
  92.  { ÄßπΘÑßΓó½∩ÑΓ óßΓáó¬π í¿Γá Zn ó »«ß½Ññ¡εε »«º¿µ¿ε í¿Γ«ó«⌐ »«ß½Ññ-Γ¿ }
  93.  { ( óßÑ «ßΓá½∞¡δÑ í¿Γδ »«ß½Ññ«óáΓѽ∞¡«ßΓ¿ ßñó¿úáεΓß∩ ¡á 1 í¿Γ )      }
  94.  { »Ñαóδ⌐ (¿¡ñѬߠ= 0) í¿Γ »«ß½Ññ«óáΓѽ∞¡«ßΓ¿ πñá½∩ÑΓß∩               }
  95.  { ( «»Ñαᵿ∩ ¡Ñ ¿º¼Ñ¡∩ÑΓ αẼÑα «íαáíáΓδóáѼ«⌐ í¿Γ«ó«⌐ ßΓ᫬¿ )      }
  96.   procedure Copy ( Isx : PStr_bit; Index,Count: word);
  97.  { è«»¿απÑΓ ó ΓѬπΘπε ßΓp«¬π Count í¿Γ ß »«º¿µ¿¿ Index ¿º ßΓp«¬¿ Isx }
  98.   procedure CopyAllBit ( Isx : PStr_bit);
  99.  { è«»¿απÑΓ ó ΓѬπΘπε ßΓp«¬π í¿Γδ ¿º ßΓp«¬¿ Isx }
  100.   procedure Delete (Index,Count: word);
  101.    { ôñá½∩ÑΓ Count í¿Γ ¿º ΓѬπΘÑ⌐ ßΓp«¬¿, ¡áτ¿¡á∩ ß »«º¿µ¿¿ Index }
  102.   procedure Mod2( Dopoln : PStr_bit);
  103.  { æ½«ªÑ¡¿Ñ »« ¼«ñπ½ε 2 ΓѬπΘÑ⌐ ßΓp«¬¿ ß« ßΓp«¬«⌐ ñ«»«½¡Ñ¡¿∩ }
  104.  { ä½¿¡á ΓѬπΘÑ⌐ ßΓp«¬¿ páó¡á ¼¿¡¿¼á½∞¡«⌐ ¿º ñóπσ ßΓp«¬      }
  105.   procedure GenPsp_n (Pol,Ust : PStr_bit; Kol : word);
  106.  { âÑ¡Ñpᵿ∩ Kol í¿Γ ÅæÅ,  Máσ.ßΓѻѡ∞ »«½¿¡«¼á ÅæÅ <= 32.         }
  107.  { çáñá±Γß∩ ¡áτá½∞¡á∩ πßΓá¡«ó¬á pÑú¿ßΓpá Ust ¿ ó¿ñ »«½¿¡«¼á Pol    }
  108.  { »« ßΓá¡ñápΓ¡δ¼ »páó¿½á¼ ñ½∩ í¿Γ«óδσ ßΓp«¬;                      }
  109.  { ìπ½Ñó«⌐ «Γó«ñ »p¿ ºáñá¡¿¿ »«½¿¡«¼á ¡Ñ óó«ñ¿Γß∩, «Γó«ñδ »«½¿¡«¼á }
  110.  { ºáñáεΓß∩ Ññ¿¡¿τ¡δ¼¿ í¿ΓἿ ó í¿Γ«ó«⌐ ßΓp«¬Ñ, »p¿τѼ ¡«¼Ñp í¿Γá  }
  111.  { páóÑ¡ ßΓѻѡ¿ «Γó«ñá »«½¿¡«¼á ( ¡π¼Ñpᵿ∩ í¿Γ ßτ¿ΓáÑΓß∩ ß 1)    }
  112.  { ìá»p¿¼Ñp 1 + ò**2 + ò**8 = '01000001'                           }
  113.   procedure GenPsp_p (Kol : word);
  114.  { Åp«ñ«½ªÑ¡¿Ñ »p«µÑßßá úÑ¡Ñpᵿ¿ Kol í¿Γ ÅæÅ ß »pÑpóá¡¡«ú« º¡áτÑ¡¿∩}
  115.  { Åpáó¿½∞¡á∩ páí«Γá «ßπΘÑßΓó½∩ÑΓß∩ Γ«½∞¬« »p¿ Kol ¬páΓ¡«¼ 8, ó Γ«¼ }
  116.  { τ¿ß½Ñ ¿ »p¿ »Ñpó«¼ ó맮óÑ (»/» GenPsp_n)                         }
  117.   procedure Insert (Dopoln : PStr_bit; Index: word);
  118. {éßΓáó½∩ÑΓ »«ñßΓp«¬π Dopoln ó ΓѬπΘπε ßΓp«¬π, ¡áτ¿¡á∩ ß »«º¿µ¿¿ Index}
  119.   procedure Init_1;  { ôßΓá¡áó½¿óáÑΓ óßÑ í¿Γδ ßΓp«¬¿ ó "1" }
  120.   procedure Init_0;  { ôßΓá¡áó½¿óáÑΓ óßÑ í¿Γδ ßΓp«¬¿ ó "0" }
  121.   procedure Init_Sim(Ust :string);
  122.  {ôßΓá¡áó½¿óáÑΓ í¿Γδ ßΓp«¬¿ ó c«ßΓ«∩¡¿∩,«»pÑñѽ∩ѼδÑ ßΓp«¬«⌐ ß¿¼ó«½«ó}
  123.   procedure Init_array (var Ust; Kol : word);
  124.  { ôßΓá¡áó½¿óáÑΓ í¿Γδ ßΓp«¬¿ ó c«ßΓ«∩¡¿∩,«»pÑñѽ∩ѼδÑ »ÑpѼѡ¡«⌐ Ust }
  125.  { ¼ÑΓ«ñ«¼ »ÑpÑ»¿ßδóá¡¿∩ Kol íá⌐Γ »ÑpѼѡ¡«⌐ ó íπΣÑp ßΓp«¬¿ í¿Γ      }
  126.   procedure Init_Mas(var Mas; Kol: word);
  127.  { ôßΓá¡áó½¿óáÑΓ Kol í¿Γ ßΓp«¬¿ ó c«ßΓ«∩¡¿∩,«»pÑñѽ∩ѼδÑ ¼áßß¿ó«¼ Mas }
  128.  { ¬áªñδ⌐ íá⌐Γ ¬«Γ«p«ú« ß«ñÑpª¿Γ bt1 ¿½¿ bt0                          }
  129.   Procedure InvBit ( Index : word);
  130.  { ê¡óÑpΓ¿pπÑΓß∩ í¿Γ ßΓp«¬¿ ¡á »«º¿µ¿¿ Index}
  131.   procedure PutBit(Nach:word; Zn: byte);
  132.    { êº¼Ñ¡∩ÑΓ º¡áτÑ¡¿Ñ í¿Γá ΓѬπΘÑ⌐ ßΓp«¬¿, ßΓ«∩ΘÑú« ¡á »«º¿µ¿¿ Nach }
  133.    { ¡á º¡áτÑ¡¿Ñ Zn. ( ü¿Γ ¡á ñá¡¡«⌐ »«º¿µ¿¿ ñ«½ªÑ¡ íδΓ∞ «»pÑñѽѡ)  }
  134.   procedure Val_array ( var Mass; Kol: word);
  135.    { ÅÑpÑßδ½áÑΓ »ÑpóδÑ Kol íá⌐Γ í¿Γ«ó«⌐ ßΓp«¬¿ ó ¼áßß¿ó íá⌐Γ }
  136.    { àß½¿ ΓѬπΘá∩ ñ½¿¡á ßΓp«¬¿ ¼Ñ¡∞ΦÑ pẼÑpá ¼áßß¿óá, Γ«    }
  137.    { ¡Ññ«ßΓáεΘ¿Ñ ñá¡¡δÑ ºá»«½¡∩εΓß∩ ¡π½∩¼¿                   }
  138.   procedure Replace (Dopoln : PStr_Bit; Index: word);
  139.  { çá¼Ñ¡∩ÑΓ í¿Γδ ΓѬπΘÑ⌐ »ÑαѼѡ¡«⌐,¡áτ¿¡á∩ ß »«º¿µ¿¿ Index,   }
  140.  { ¡á í¿Γδ »ÑαѼѡ¡«⌐ Dopoln                                   }
  141.     private  { çáΘ¿Γá «Γ »«½∞ºóáΓѽ∩ }
  142.   procedure ReplaceGrBt(Index, Kol, Value: word);
  143.  { ôßΓá¡áó½¿óáÑΓ Kol í¿Γ ßΓp«¬¿ (<16), ¡áτ¿¡á∩ ß »«º¿µ¿¿ Index        }
  144.  {  ó c«ßΓ«∩¡¿∩,«»pÑñѽ∩ѼδÑ »ÑαѼѡ¡«⌐ Value                         }
  145.   end;
  146.  
  147.   PBitFile = ^TBitFile;
  148.   TBitFile = object(TStr_Bit)
  149.    Position,    { ÆѬπΘá∩ «ípáíáΓδóáѼá∩ »«º¿µ¿∩ í¿Γá ó Σá⌐½Ñ }
  150.    PosBuf,      { ÆѬπΘá∩ «ípáíáΓδóáѼá∩ »«º¿µ¿∩ í¿Γá ó íπΣÑpÑ}
  151.    PosBufMax,   { ä½¿¡á íπΣÑpá ó í¿Γáσ }
  152.    PosMax : longint;  { ä½¿¡á Σá⌐½á ó í¿Γáσ }
  153.  
  154.     constructor Init(ASizeMax: Word; Size: word);
  155.   { ASizeMax - ¼á¬ß¿¼á½∞¡á∩ ñ½¿¡á ßΓp«¬¿ ó í¿Γáσ                    }
  156.   { Size  - pẼÑp »p«¼ÑªπΓ«τ¡«ú« íπΣÑpá ñ½∩ τΓÑ¡¿∩ ñá¡¡δσ ¿º Σá⌐½á }
  157.     destructor Done;
  158.     function OpenBitFile (Name: string; Mode: word):word;
  159.   { ÄΓ¬αδΓ¿Ñ Σá⌐½á ñ½∩ «íαáí«Γ¬¿ ó í¿Γ«ó«¼ ó¿ñÑ                      }
  160.   { Name  - ¿¼∩ Σá⌐½á, ß ¬«Γ«pδ¼ íπñπΓ »p«¿ºó«ñ¿Γ∞ß∩ «»Ñpᵿ¿ «í¼Ñ¡á }
  161.   { Mode  - pѪ¿¼ «Γ¬pδΓ¿∩ Σá⌐½á                                     }
  162.     function CloseBitFile:word;
  163.   { çá¬αδΓ¿Ñ «íαáíáΓδóáѼ«ú« Σá⌐½á  }
  164.     function NomTekBi: longint;
  165.  { é«ºóαáΘáÑΓß∩ áíß«½εΓ¡δ⌐ ¡«¼Ñα »Ñαó«ú« í¿Γá ΓѬπΘÑ⌐ í¿Γ«ó«⌐ ßΓ᫬¿ }
  166.     function ReadStr(Count:word): word;
  167.    { çừ½¡∩εΓß∩ Count í¿Γ ßΓp«¬¿ º¡áτÑ¡¿∩¼¿ ¿º Σá⌐½á }
  168.     function ReadBit: Byte;
  169.    { ùΓÑ¡¿Ñ í¿Γá ¿º Σá⌐½á, Ñß½¿ αѺπ½∞ΓáΓ >1 => «Φ¿í¬á óδ»-∩ «»Ñαᵿ¿ }
  170.     function ReadNomer(Dln:byte): word;
  171.    { öπ¡¬µ¿∩ ßτ¿ΓδóáÑΓ ¿º Σá⌐½á DLN í¿Γ ¿ óδñáÑΓ ó ¬áτÑßΓóÑ αѺ-Γá }
  172.     function SeekStr(Polog : longint): word;
  173.    { ôßΓá¡«ó¬á ΓѬπΘÑ⌐ »«º¿µ¿¿ ó Σá⌐½Ñ ¡á í¿Γ«óδ⌐ φ½Ñ¼Ñ¡Γ Polog }
  174.     function SizeOfFile : longint;
  175.    { é«ºópáΘáÑΓ ΓѬπΘ¿⌐ pẼÑp Σá⌐½á ó í¿Γáσ }
  176.     function WriteStr: word;
  177.    { ü¿Γ«óá∩ ßΓp«¬á ºá»¿ßδóáÑΓß∩ ó ¬«¡Ñµ Σá⌐½á }
  178.     function WriteBit(Zn:byte): word;
  179.    { ü¿Γ Zn ºá»¿ßδóáÑΓß∩ ó ¬«¡Ñµ Σá⌐½á }
  180.     function WriteNomer (ZN:word; Dln: byte): word;
  181.    { î½áñΦ¿Ñ Dln αáºα∩ñ«ó »ÑαѼѡ¡«⌐ Zn ºá»¿ßδóáεΓß∩ ó ¬«¡Ñµ Σá⌐½á }
  182.     procedure ChangeOrderBit;
  183.    { Åα«µÑñπαá ¿º¼Ñ¡∩ÑΓ »«α∩ñ«¬ ß½Ññ«óá¡¿∩ í¿Γ ó¡πΓα¿ íá⌐Γá »α¿    }
  184.    { óδ»«½¡Ñ¡¿¿ «»Ñαᵿ⌐ τΓÑ¡¿∩/ºá»¿ß¿ ó Σá⌐½.                     }
  185.    { Åα«µÑñπαá ñ«½ª¡á óδºδóáΓ∞ß∩ ßαáºπ »«ß½Ñ ¿¡¿µ¿á½¿ºáµ¿¿ «íΩѬΓá.}
  186.    { æΓá¡ñáαΓ¡δ⌐ »«α∩ñ«¬ ß½Ññ«óá¡¿∩, πßΓá¡áó½¿óáÑΓß∩ »α¿           }
  187.    { ¿¡¿µ¿á½¿ºáµ¿¿ «íΩѬΓá. éÑα¡πΓ∞ »«α∩ñ«¬ ß½Ññ«óá¡¿∩ í¿Γ ó       }
  188.    { ßΓá¡ñáαΓ¡«Ñ ß«ßΓ«∩¡¿Ñ »«ß½Ñ ó맮óá »α«µÑñπαδ ¡Ñ½∞º∩.          }
  189.  
  190.     private  { çáΘ¿Γá »ÑpѼѡ¡δσ «Γ ¿º¼Ñ¡Ñ¡¿∩ »«½∞ºóáΓѽѼ }
  191.  { äá¡¡δÑ »ÑpѼѡ¡δÑ ¡Ñ½∞º∩ ¿ß»«½∞º«óáΓ∞ ó »p«µÑñπpáσ ¡áß½ÑñπѼδσ «íΩÑ¬Γ«ó }
  192.    FileDis : file;
  193.    OrderBitRevers: boolean; { êº¼Ñ¡Ñ¡¿Ñ »«α∩ñ¬á τΓÑ¡¿∩/ºá»¿ß¿ í¿Γ Σá⌐½á }
  194.    RazmBuf,RegOtkr : word;
  195.    PBuff : pointer;   { ô¬áºáΓѽ∞ ¡á ¡áτὫ íπΣÑpá }
  196.   end;
  197.  
  198.           { éß»«¼«úáΓѽ∞¡δÑ »α«µÑñπαδ ¿ Σπ¡¬µ¿¿ }
  199.  function RBit( M: pointer ; N : word) : byte;
  200.  { öπ¡¬µ¿∩ óδñѽ∩ÑΓ í¿Γ ¿º ¼áßß¿óá ß áñpÑß«¼ M ß í¿Γá N }
  201.  procedure PBit( M: pointer ; Nach : word; Zn : byte);
  202.  { Åα«µÑñπαᠺỿßδóáÑΓ í¿Γ Zn ó ¼áßß¿ó ß áñpÑß«¼ M ß í¿Γá N }
  203.  
  204. implementation
  205.  
  206. const ErrObr : string = 'ÄΦ¿í¬á! Äíαáí«Γ¬á ñá¡¡δσ ¿º ¡Ñ«Γ¬αδΓ«ú« Σá⌐½á!';
  207. var dlina_pol : boolean; {é¡πΓpÑ¡¡∩∩ »ÑpѼѡ¡á∩ ñ½∩ »p«µ.GenPsp}
  208.  
  209. Procedure Bool(mis,Msr,mrez : pointer; Nbis,kol: word; Vidop: byte);
  210.   near;  assembler;
  211.  { Åp«µÑñπpá óδñѽ∩ÑΓ KOL í¿Γ ¿º ¼áßß¿óá ß áñpÑß«¼ MIS ß í¿Γá NBIS }
  212.  { »p«¿ºó«ñ¿Γ ½«ú¿τÑ߬«Ñ ñÑ⌐ßΓó¿Ñ Vidop c í¿ΓἿ ¼áßß¿óá îsr       }
  213.  { ¿ ºá»¿ßδóáÑΓ ó ¼áßß¿ó MREZ                                      }
  214.    ASM
  215.       push    ds
  216.       cld
  217.       mov     bx,offset @Bool_op  { ºá»¿ß∞ »ÑpѼѡ¡«⌐ ¬«¼á¡ñδ }
  218.       mov     al,Vidop            { ó »«½Ñ ¬«¼á¡ñ, óδ»«½¡∩Ѽδσ}
  219.       mov     cs:[BX],al          { ó µ¿¬½Ñ                   }
  220.  
  221.       lds     bx,Mis      { ÇñpÑß ¿ßσ«ñ¡«ú« ¼áßß¿óá           }
  222.       push    ds
  223.       lds     si,Msr      { ÇñpÑß ¼áßß¿óá ßpáó¡Ñ¡¿∩           }
  224.       les     di,Mrez     { ÇñpÑß ¼áßß¿óá pѺπ½∞ΓáΓá          }
  225.       MOV     AX,Nbis     { ¡«¼Ñp í¿Γá ¡áτá½á óδ»-∩ «»Ñpᵿ¿  }
  226.       mov     cl,3
  227.       shr     ax,cl
  228.       add     bx,ax
  229.       mov     dx,KOL      { Ko½¿τÑßΓó« »ÑpÑßδ½áѼδσ í¿Γ       }
  230.       add     dx,7        { »ÑpÑßτ¿Γ὿ ó                     }
  231.       shr     dx,cl       { ¬«½¿τÑßΓó« íá⌐Γ                   }
  232.       MOV     cx,Nbis
  233.       and     cl,7        { óδñѽ∩Ѽ Γp¿ ¼½áñΦ¿σ í¿Γá         }
  234.       pop     bp          { ßÑú¼Ñ¡Γ¡δ⌐ áñpÑß ¿ßσ«ñ¡«⌐ ßΓp«¬¿  }
  235. @Povt:
  236.       push    ds
  237.       mov     ds,bp       { é«ßßΓá¡«ó½Ñ¡¿Ñ ßÑú¼Ñ¡Γ.pÑú.¿ßσ.¼áßß }
  238.       mov     ax,[bx]
  239.       pop     ds
  240.       ror     ax,cl       { éδp«ó¡∩Γ∞ ¿ßσ.ñá¡¡δÑ ¡á úpá¡¿µπ íá⌐Γá}
  241. @bool_op:
  242.       and     al,[si]     { éδ»«½¡¿Γ∞ ½«ú¿τÑ߬πε «»Ñpᵿε}
  243.       stosb               { çừ¼¡¿Γ∞ pѺπ½∞ΓáΓ «»Ñpᵿ¿ }
  244.       inc     si
  245.       inc     bx
  246.       dec     dx
  247.       jnz     @Povt       { û¿¬½ ½«ú¿τÑ߬«⌐ «ípáí«Γ¬¿  }
  248.       pop     ds          { éδσ«ñ ¿º »/» }
  249.    END;
  250.  
  251. procedure MovBit( mis,mrez : pointer ; NBis,NBrez,Kol : word);
  252.   near;  assembler;
  253. { Åp«µÑñπpá óδñѽ∩ÑΓ KOL í¿Γ ¿º ¼áßß¿óá ß áñpÑß«¼ MIS ß í¿Γá NBIS }
  254. { ¿ ºá»¿ßδóáÑΓ ó ¼áßß¿ó MREZ ß í¿Γá MBREZ                         }
  255.    ASM
  256.          push    ds
  257.          CLD     { ôßΓá¡«ó¿Γ∞ ¡á»αáó½Ñ¡¿Ñ ¿º¼Ñ¡Ñ¡¿∩ ¿¡ñѬ߫ó }
  258.          lds     si,Mis         { ÇñpÑß ¿ßσ«ñ¡«ú« ¼áßß¿óá    }
  259.          les     di,Mrez        { ÇñpÑß ¼áßß¿óá pѺπ½∞ΓáΓá   }
  260.          mov     dx,KOL         { Ko½¿τÑßΓó« »ÑpÑßδ½áѼδσ í¿Γ}
  261.          mov     ax,Nbrez
  262.          mov     bx,ax
  263.          mov     cl,3
  264.          shr     ax,cl
  265.          add     di,ax
  266.          MOV     AX,Nbis    { !! Ä»ÑpѪáεΘÑÑ ºá»«½¡Ñ¡¿Ñ pÑú¿ßΓpá }
  267.          and     bx,7           { pѺπ½∞ΓáΓ óδp«ó¡Ñ¡ »« }
  268.          jz      @GRAN          { úpá¡¿µÑ íá⌐Γá ?       }
  269.  
  270.          neg     bl
  271.          add     bl,8           { ¡ÑΓ  }
  272.          shr     ax,cl
  273.          add     si,ax          { éδí«p »Ñpóδσ í¿Γ ¿ßσ«ñ¡«ú« }
  274.          lodsw                  { ¼áßß¿óá ñá¡¡δσ             }
  275.          mov     cx,Nbis
  276.          and     cl,7
  277.          ror     ax,cl          { éδpáó¡¿óá¡¿Ñ ¡á úpá¡¿µπ íá⌐Γá }
  278.          mov     cl,bl
  279.          mov     ah,es:[di]
  280.          shl     ah,cl          { çừ¼¿¡á¡¿Ñ í¿Γ pѺπ½∞ΓáΓá }
  281.          ror     ax,cl
  282.          mov     al,ah
  283.          stosb
  284.          sub     dx,bx         { ô¼Ñ¡∞ΦÑ¡¿Ñ ¬«½-óá «ßΓáóΦ¿σß∩ í¿Γ}
  285.          jbe     @Finis
  286.          mov     ax,Nbis
  287.          add     ax,bx         { ùáßΓ∞ í¿Γ πªÑ »ÑpÑ߽὿ }
  288.          lds     si,Mis
  289. @GRAN:
  290.          mov     cl,3
  291.          add     dx,7
  292.          shr     dx,cl
  293.          JZ      @Finis
  294.          push    ax
  295.          shr     ax,cl
  296.          pop     cx
  297.          add     si,ax
  298.          and     cl,7           { êßσ«ñ¡δ⌐ ¼áßß¿ó óδp«ó¡Ñ¡ ¡á }
  299.          jnz     @Povt          { úpá¡¿µπ íá⌐Γá ?             }
  300.  
  301.          mov     cx,dx          { ñá }
  302.   rep    movsb
  303.          jmp     @Finis
  304. @Povt:                          { ¡ÑΓ }
  305.          mov     ax,[si]
  306.          ror     ax,cl
  307.          stosb
  308.          inc     si
  309.          dec     dx
  310.          jnz     @Povt         { û¿¬½ »ÑpÑß佬¿ íá⌐Γ }
  311. @Finis:
  312.          pop     ds            { éδσ«ñ ¿º »/» }
  313.    END;
  314.  
  315. Function Isub ( m:pointer ; N : word; dln: byte) : word;
  316. { öπ¡¬µ¿∩ óδñѽ∩ÑΓ c½«ó« ¿º ¼áßß¿óá ß áñpÑß«¼ M ß í¿Γá N }
  317. { é ß½«óÑ ºá»«½¡Ñ¡δ DLN ¼½áñΦ¿σ í¿Γ                      }
  318.        near; assembler;
  319.        ASM
  320.        les     di,M            {Å«½πτ¿Γ∞ áñpÑß pѺπ½∞ΓáΓá}
  321.        mov     ax,N            {H«¼Ñp í¿Γá               }
  322.        mov     cl,3
  323.        shr     ax,cl
  324.        mov     cx,N
  325.        and     cl,7
  326.        add     di,ax
  327.        mov     ax,es:[di]      {çáúpπº¬á ¿ßσ«ñ¡«ú« º¡áτÑ¡¿∩}
  328.        ror     ax,cl
  329.        inc     di
  330.        mov     bx,es:[di]      {çáúpπº¬á óΓ«p«ú« íá⌐Γá}
  331.        ror     bx,cl
  332.        mov     ah,bl
  333.        mov     cl,16
  334.        sub     cl,DLN
  335.        rol     ax,cl           { Äí¡π½Ñ¡¿Ñ ¡Ñº¡áτáΘ¿σ í¿Γ}
  336.        shr     ax,cl
  337.        END;
  338.  
  339. procedure Upak( Mis, Mrez : pointer ; N : word);
  340.  { Åp«µÑñπpá óδñѽ∩ÑΓ N í¿Γ ¿º ¼áßß¿óá ß áñpÑß«¼ MIS, ó ¬«Γ«p«¼ }
  341.  { í¿Γδ páß»«½«ªÑ¡δ ó ¼½áñΦÑ¿σ í¿Γáσ íá⌐Γá                      }
  342.  { ¿ ºá»¿ßδóáÑΓ ¿σ ó π»á¬«óá¡¡«¼ ó¿ñÑ ó ¼áßß¿ó MREZ             }
  343. near; assembler;   asm
  344.         mov     dx,ds       { æ«σpá¡¿Γ∞ DS }
  345.         lds     si,mis      { Å«½πτ¿Γ∞ áñpÑß ¿ßσ«ñ¡«ú« ¼áßß¿óá}
  346.         les     di,mrez     { Å«½πτ¿Γ∞ áñpÑß ¼áßß¿óá pѺπ½∞ΓáΓá }
  347.         mov     cx,N
  348.         add     cx,7
  349.         shr     cx,1
  350.         shr     cx,1
  351.         shr     cx,1
  352.         cld
  353. @povt:  lodsb
  354.         ror     ax,1
  355.         lodsb
  356.         ror     ax,1
  357.         lodsb
  358.         ror     ax,1
  359.         lodsb
  360.         ror     ax,1
  361.         lodsb
  362.         ror     ax,1
  363.         lodsb
  364.         ror     ax,1
  365.         lodsb
  366.         ror     ax,1
  367.         lodsb
  368.         ror     ax,1
  369.         mov     al,ah
  370.         stosb
  371.         loop    @povt
  372.         mov     ds,dx       { é«ßßΓá¡«ó½Ñ¡¿Ñ DS }
  373.       end;
  374.  
  375.  constructor TStr_Bit.Init(ASizeMax: Word);
  376.  begin
  377.   dlina := 0;     razmer := (ASizeMax + 7) div 8;
  378.   Max_dlina := ASizeMax;      GetMem(Pmas,razmer)
  379.  end;
  380.  
  381.  destructor TStr_Bit.Done;
  382.      begin  FreeMem(Pmas,razmer)    end;
  383.  
  384.   function TStr_Bit.Length: word;
  385.    { é«ºópáΘáÑΓ ΓѬπΘπε ñ½¿¡π ßΓp«¬¿ }
  386.     begin   Length := dlina    end;
  387.  
  388.   function TStr_Bit.Pos(SubS: PStr_bit; Nach, Shag : word ): word;
  389.    { é«ºópáΘáÑΓ »«º¿µ¿ε, ¡áτ¿¡á∩ ß ¬«Γ«p«⌐ ó ΓѬπΘÑ⌐ ßΓp«¬Ñ }
  390.    { páß»«½áúáÑΓß∩ »«ñßΓp«¬á SubS;                          }
  391.    { Å«¿ß¬ ¡áτ¿¡áÑΓß∩ ß í¿Γá Nach, óßÑ »«ß½ÑñπεΘ¿Ñ ßpáó¡Ñ¡¿∩}
  392.    { óδ»«½¡∩εΓß∩ ¿º¼Ñ¡Ñ¡¿Ñ¼ ¿ßσ«ñ¡«⌐ »«º¿µ¿¿ ß Φáú«¼ Shag   }
  393.    { btNotFound = $FFFF  - »«ñßΓp«¬á ¡Ñ ¡á⌐ñÑ¡á             }
  394.   label end_pos, end_sr, e_pos;
  395.   var i, dl_sr, jt, jkom, Komb_srav, Razm : word;
  396.   begin
  397. {$IFOPT R+}
  398.    if ( Dlina < Nach) or (Dlina - Nach < SubS^.dlina)
  399.       Then begin Error_Str_bit := btDlst;  goto e_pos    end;
  400. {$ENDIF}
  401.    Razm := Subs^.dlina;      i := Nach;
  402.    if Razm <= 16 then begin
  403.      Komb_srav := Isub(SubS^.Pmas,0,Razm);
  404.       repeat
  405.        if Isub(Pmas,i,Razm) = Komb_srav then goto end_pos;
  406.        inc(i,Shag)
  407.       until i > Dlina - Razm
  408.                       end
  409.                  else begin
  410.      Komb_srav := Isub(SubS^.Pmas,0,16);
  411.       repeat
  412.        if Isub(Pmas,i,16) = Komb_srav then begin
  413.          dl_sr := Razm - 16;      jt := i + 16;  jkom := 16;
  414.           while dl_sr > 16 do                          begin
  415.            if Isub(Pmas,jt,16) <> Isub(SubS^.Pmas,jkom,16) then goto end_sr;
  416.            inc (jt,16);  dec (dl_sr,16);  inc(jkom,16)  end;
  417.           if Isub(Pmas,jt,dl_sr) = Isub(SubS^.Pmas,jkom,dl_sr)
  418.              then goto end_pos
  419.                                            end;
  420.          end_sr: inc(i,Shag)
  421.         until i > Dlina - Razm
  422.                       end;  { Else }
  423.   e_pos:   i := btNotFound;
  424.   end_pos: Pos := i
  425.   end;    { TStr_Bit.Pos }
  426.  
  427. function RBit( M: pointer ; N : word) : byte;          assembler;
  428.  { öπ¡¬µ¿∩ óδñѽ∩ÑΓ í¿Γ ¿º ¼áßß¿óá ß áñpÑß«¼ M ß í¿Γá N }
  429.       asm
  430.         les     di,M           { Å«½πτ¿Γ∞ áñpÑß pѺπ½∞ΓáΓá }
  431.         mov     ax,N           { H«¼Ñp í¿Γá                }
  432.         mov     CX,AX
  433.         shr     ax,1
  434.         shr     ax,1
  435.         shr     ax,1
  436.         add     di,ax
  437.         mov     al,es:[di]     { çáúpπº¬á ¿ßσ«ñ¡«ú« º¡áτÑ¡¿∩}
  438.         and     cl,00000111b
  439.         shr     al,cl
  440.         and     al,00000001b
  441.       end;
  442.  
  443.   function TStr_Bit.GetBit(Nach:word): byte;
  444.    { é«ºópáΘáÑΓ º¡áτÑ¡¿Ñ í¿Γá ΓѬπΘÑ⌐ ßΓp«¬¿ ¡á »«º¿µ¿¿ Nach }
  445.    begin
  446. {$IFOPT R+}
  447.    if Dlina < Nach Then begin Error_Str_bit := btGran; EXIT  end;
  448. {$ENDIF}
  449.    GetBit := RBit(Pmas,Nach);
  450.    end;
  451.  
  452. {$L Sum_ed.obj}
  453. Function  TStr_Bit.Kol_ed : word;                         external;
  454. { Åp«µÑñπpá »«ñßτ¿ΓδóáÑΓ ¬«½¿τÑßΓó« 1 í¿Γ ó í¿Γ«ó«⌐ ßΓα«¬Ñ        }
  455.  
  456.   function TStr_Bit.ModReg( VidReg : PStr_bit ; Nbis : word) : byte;
  457. { öπ¡¬µ¿∩ ¼«ñѽ¿pπÑΓ ßπ¼¼¿p«óá¡¿Ñ »« mod 2 »« «Γó«ñá¼ pÑú¿ßΓpá VidReg,
  458.  ºáñá¡¡δ¼ í¿Γ«ó«⌐ ßΓp«¬«⌐. æπ¼¼¿p«óá¡¿Ñ ¡áτ¿¡áÑΓß∩ ß í¿Γá NBIS ¡á
  459.  ΓѬπΘÑ⌐ í¿Γ«ó«⌐ ßΓp«¬Ñ. ÉѺπ½∞ΓáΓ páí«Γδ Σπ¡¬µ¿¿ páóÑ¡ bt1 ¿½¿ bt0  }
  460.  var i : byte;
  461.   begin
  462. {$IFOPT R+}
  463.    if Nbis + VidReg^.dlina > dlina then Error_Str_bit := btGran;
  464. {$ENDIF}
  465.     ASM
  466.       push    ds
  467.      lds    di,DWORD PTR ss:[bp+6]   { ÇñpÑß ¡áτá½á ßΓpπ¬Γπpδ ñá¡¡δσ}
  468.      lds    si,DWORD PTR [di+6]      { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  469.      les    di,VidReg      { ÇñpÑß ¡áτá½á ßΓpπ¬Γπpδ ñá¡¡δσ pÑú-pá «»Ñpᵿ¿ }
  470.      mov    bx,es:[di]    { è«½¿τÑßΓó« í¿Γ ó ¼«ñѽ¿ pÑú¿ßΓpá }
  471.      push   bx
  472.      les    di,DWORD PTR es:[di+6]   { ÇñpÑß ¡áτá½á ßΓp«¬¿ ¼«ñѽ¿ pÑú¿ßΓpá }
  473.       mov     ax,Nbis
  474.       shr     ax,1
  475.       shr     ax,1
  476.       shr     ax,1
  477.       add     si,ax
  478.       xor     dl,dl     { Å«ñú«Γ«ó¬á ∩τÑ⌐¬¿ ñ½∩ ßπ¼¼ »« mod 2 }
  479.       shr     bx,1
  480.       shr     bx,1
  481.       shr     bx,1      { ù¿ß½« íá⌐Γ ó ¼«ñѽ¿ pÑú¿ßΓpá}
  482.       inc     bx         { ÉÑú¿ßΓp »pÑñßΓáó½Ñ¡ »πßΓ«⌐ ßΓp«¬«⌐ }
  483.       mov     cx,Nbis
  484.       and     cl,7
  485.       cld
  486. @Povt:
  487.       mov     ax,[si]
  488.       ror     ax,cl
  489.       and     al,es:[di]
  490.       dec     bx
  491.       jz     @Finis
  492.       xor     dl,al
  493.       inc     si
  494.       inc     di
  495.       jmp     @Povt
  496. @Finis:
  497.       pop     cx         { Äípáí«Γ¬á »«ß½Ññ¡Ñú« íá⌐Γá }
  498.       and     cl,7
  499.       xor     ah,ah
  500.       ror     ax,cl
  501.       xor     dl,ah
  502.       xor     ax,ax             { éδσ«ñ ¿º »p«úpá¼¼δ }
  503.       xor     dl,al
  504.       jp      @NEX              { pѺπ½∞ΓáΓ ß½«ªÑ¡¿∩ }
  505.       inc     ax                { »ÑpÑñáÑΓß∩ τÑpѺ al}
  506. @NEX: pop     ds
  507.       mov     i,AL   { »ÑpÑñáτá »ápá¼ÑΓpá ¿º »«ñpp«úpá¼¼δ}
  508.     END;
  509.    Modreg := i;
  510.   end;
  511.  
  512.   function TStr_Bit.Val_sim(Kol:byte): string;
  513.    { ÅpÑ«ípáºπÑΓ »ÑpóδÑ KOL í¿Γ«ó ßΓp«¬¿ ¬ ß¿¼ó½∞¡«¼π ó¿ñπ   }
  514.   var i : word;
  515.       Ssim : string;
  516.   begin
  517.     if Dlina < Kol then Kol := Dlina;
  518.     Ssim := '';
  519.     if Kol <> 0 then for i := 1 to Kol do
  520.          Ssim := Ssim + Chr( RBit(Pmas,i-1) + ord('0') );
  521.     Val_sim := Ssim;
  522.   end;
  523.  
  524.   procedure TStr_Bit.Bool_op (StrBaz, Dop: PStr_bit; Index, Vid_op: word);
  525.  { éδ»«½¡∩ÑΓ ß½«ªÑ¡¿Ñ í¿Γ ßΓp«¬¿ StrBaz, ¡áτ¿¡á∩ ß »«º¿µ¿¿ Index       }
  526.  { ß« ßΓp«¬«⌐ Dop »« »páó¿½á¼ íπ½Ñó«⌐ á½úÑípδ, «»pÑñѽ∩Ñ¼δ¼ »ápá¼ÑΓα«¼ }
  527.  { Vid_op, pѺπ½∞ΓáΓ ºá»¿ßδóáÑΓß∩ ó ΓѬπΘπε í¿Γ«óπε ßΓp«¬π.            }
  528.   begin
  529.    dlina := Dop^.Dlina;
  530. {$IFOPT R+}
  531.    if Index + Dop^.dlina >= StrBaz^.dlina then begin
  532.               dlina := StrBaz^.dlina - Index;
  533.               Error_Str_bit := btGran          end;
  534.    if dlina > Max_dlina Then begin
  535.               dlina := Max_dlina;
  536.               Error_Str_bit := btGran  end;
  537. {$ENDIF}
  538.    Bool( StrBaz^.Pmas, Dop^.Pmas, Pmas, Index, dlina, Vid_op)
  539.   end;
  540.  
  541.   procedure TStr_Bit.Mod2( Dopoln : PStr_bit);
  542.  { æ½«ªÑ¡¿Ñ »« ¼«ñπ½ε 2 ΓѬπΘÑ⌐ ßΓp«¬¿ ß« ßΓp«¬«⌐ ñ«»«½¡Ñ¡¿∩ }
  543.   var i : word;
  544.   begin
  545.    if Dopoln^.dlina < dlina then dlina := Dopoln^.dlina;
  546.    i := (dlina + 7) div 8;
  547.      asm
  548.      push   ds
  549.      lds    di,ss:[bp+6]   { ÇñpÑß ¡áτá½á ßΓpπ¬Γπpδ ñá¡¡δσ}
  550.      les    di,[di+6]      { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  551.      lds    si,Dopoln      { Å«½πτ¿Γ∞ áñpÑß cΓp«¬¿ ñ«»«½¡.}
  552.      lds    si,[si+6]      { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  553.      mov    cx,I           { H«¼Ñp í¿Γá                   }
  554.      cld
  555. @cikl:  lodsb
  556.         xor     al,es:[di]
  557.         stosb
  558.         loop    @cikl
  559.      pop    ds
  560.      end;
  561.   end;
  562.  
  563. {$L Psp_8.obj}
  564. Procedure GenPsp_8 ( m: pointer ; Kol : word);              external;
  565. { Åp«µÑñπpá úÑ¡Ñp¿pπÑΓ KOL íá⌐Γ ÅæÅ ó ¼áßß¿ó ß áñpÑß«¼ î
  566. ; Å«óΓ«p¡δ⌐ ó맮ó »p«µÑñπpδ »p«ñ«½ªáÑΓ »p«µÑßß úÑ¡Ñpᵿ¿
  567. ; ÅæÅ ß »pÑpóá¡¡«ú« º¡áτÑ¡¿∩                                      }
  568. Procedure InPsp_8( Pol,Ust : byte);                       external;
  569. { çáñá±Γß∩ ¡áτá½∞¡á∩ πßΓá¡«ó¬á pÑú¿ßΓpá Ust ¿ ó¿ñ »«½¿¡«¼á Pol
  570. ; ñ½∩ »p«µÑñπpδ GenPsp_8, Má¬ß¿¼á½∞¡á∩ ßΓѻѡ∞ »«½¿¡«¼á ÅæÅ <= 8  }
  571.  
  572. {$L Psp32.obj}
  573. Procedure GenPsp32 ( m: pointer ; Kol : word);               external;
  574. { Åp«µÑñπpá úÑ¡Ñp¿pπÑΓ KOL íá⌐Γ ÅæÅ ó ¼áßß¿ó ß áñpÑß«¼ î
  575. ; Å«óΓ«p¡δ⌐ ó맮ó »p«µÑñπpδ »p«ñ«½ªáÑΓ »p«µÑßß úÑ¡Ñpᵿ¿
  576. ; ÅæÅ ß »pÑpóá¡¡«ú« º¡áτÑ¡¿∩                                    }
  577.  
  578. Procedure InPsp32( var Pol; Ust: pointer);               external;
  579. { çáñá±Γß∩ ¡áτá½∞¡á∩ πßΓá¡«ó¬á pÑú¿ßΓpá Ust ¿ ó¿ñ »«½¿¡«¼á Pol
  580. ; ñ½∩ »p«µÑñπpδ GenPsp32, Má¬ß¿¼á½∞¡á∩ ßΓѻѡ∞ »«½¿¡«¼á ÅæÅ <= 32 }
  581.  
  582.   Procedure TStr_Bit.GenPsp_p (Kol : word);
  583. { Åp«ñ«½ªÑ¡¿Ñ »p«µÑßßá úÑ¡Ñpᵿ¿ Kol í¿Γ ÅæÅ ß »pÑpóá¡¡«ú« º¡áτÑ¡¿∩}
  584. { Åpáó¿½∞¡á∩ páí«Γá «ßπΘÑßΓó½∩ÑΓß∩ Γ«½∞¬« »p¿ Kol ¬páΓ¡«¼ 8, ó Γ«¼ }
  585. { τ¿ß½Ñ ¿ »p¿ »Ñpó«¼ ó맮óÑ (»±» GenPsp_n)                         }
  586.   var i : word;
  587.   begin
  588.    if Max_dlina >= kol then dlina := Kol
  589.                        else begin
  590.          dlina := Max_dlina;  Error_Str_bit := btGran   end;
  591.    i := (dlina+7) div 8;
  592.    if dlina_pol then GenPsp_8 ( Pmas, i )
  593.                 else GenPsp32 ( Pmas, i )
  594.   end;
  595.  
  596.   Procedure TStr_Bit.GenPsp_n (Pol,Ust : PStr_bit; Kol : word);
  597. { âÑ¡Ñpᵿ∩ Kol í¿Γ ÅæÅ,  Máσ.ßΓѻѡ∞ »«½¿¡«¼á ÅæÅ <= 32.         }
  598. { çáñá±Γß∩ ¡áτá½∞¡á∩ πßΓá¡«ó¬á pÑú¿ßΓpá Ust ¿ ó¿ñ »«½¿¡«¼á Pol    }
  599. { »« ßΓá¡ñápΓ¡δ¼ »páó¿½á¼ ñ½∩ í¿Γ«óδσ ßΓp«¬;                      }
  600. { ìπ½Ñó«⌐ «Γó«ñ »p¿ ºáñá¡¿¿ »«½¿¡«¼á ¡Ñ óó«ñ¿Γß∩, «Γó«ñδ »«½¿¡«¼á }
  601. { ºáñáεΓß∩ Ññ¿¡¿τ¡δ¼¿ í¿ΓἿ ó í¿Γ«ó«⌐ ßΓp«¬Ñ, »p¿τѼ ¡«¼Ñp í¿Γá  }
  602. { páóÑ¡ ßΓѻѡ¿ «Γó«ñá »«½¿¡«¼á ( ¡π¼Ñpᵿ∩ í¿Γ ßτ¿ΓáÑΓß∩ ß 1)    }
  603. { ìá»p¿¼Ñp 1 + ò**2 + ò**8 = '01000001'                           }
  604.   var Pol_vn : array [1..2] of word;    i : word;
  605.   begin
  606.    if Max_dlina >= kol then dlina := Kol
  607.                        else begin
  608.          dlina := Max_dlina;  Error_Str_bit := btGran   end;
  609.    i := (dlina+7) div 8;
  610.    dlina_pol := True;
  611.    if (Pol^.dlina < 9)  and (Pol^.dlina > 1) then begin
  612.      InPsp_8(ISub(Pol^.Pmas,0,Pol^.dlina), Isub(Ust^.Pmas,0,Pol^.dlina));
  613.      GenPsp_8 ( Pmas, i )                         end
  614.      else if (Pol^.dlina < 32) and (Pol^.dlina > 8)
  615.          then  begin
  616.       dlina_pol := False;         Pol^.Val_array ( Pol_vn, 4 );
  617.       InPsp32( Pol_vn, Ust^.Pmas);         GenPsp32( Pmas, i )
  618.                end
  619.          else  writeln('ñ½∩ ßΓѻѡ¿ »«½¿¡«¼á',Pol^.dlina,
  620.                        ' úÑ¡Ñpᵿ∩ ÅæÅ ¡Ñ «ßπΘÑßΓó½∩ÑΓß∩')
  621.   end;
  622.  
  623.   procedure TStr_Bit.Concat ( Dopoln : PStr_bit);
  624.   var i : word;
  625.   begin
  626. {$IFOPT R+}
  627.    i := Max_Dlina - Dlina;
  628.    if i >= Dopoln^.dlina Then i := Dopoln^.dlina
  629.                          else Error_Str_bit := btGran;
  630. {$Else}
  631.    i := Dopoln^.dlina;
  632. {$ENDIF}
  633.    MovBit(Dopoln^.Pmas,Pmas,0,Dlina,i);
  634.    inc(dlina,i)
  635.   end;
  636.  
  637.   procedure TStr_Bit.Copy ( Isx : PStr_bit; Index,Count: word);
  638.  { è«»¿απÑΓ ó ΓѬπΘπε ßΓp«¬π Count í¿Γ ß »«º¿µ¿¿ Index ¿º ßΓp«¬¿ Isx }
  639.   var i : word;
  640.   begin
  641.   Dlina := Count;
  642.   if Count = 0 then Exit;
  643. {$IFOPT R+}
  644.    if Index > Isx^.Dlina then i := 0
  645.                          else i := Isx^.Dlina - Index;
  646.    if i < Dlina Then begin Dlina := i;
  647.                            Error_Str_bit := btNeop     end;
  648.    if Dlina > Max_Dlina then begin
  649.        Dlina := Max_Dlina;   Error_Str_bit := btGran   end;
  650. {$ENDIF}
  651.    if Dlina<>0 then MovBit(Isx^.Pmas,Pmas,Index,0,Dlina);
  652.   end;
  653.  
  654.   procedure TStr_Bit.CopyAllBit( Isx : PStr_bit);
  655.  { è«»¿απÑΓ ó ΓѬπΘπε ßΓp«¬π Count í¿Γ ß »«º¿µ¿¿ Index ¿º ßΓp«¬¿ Isx }
  656.   var i : word;
  657.   begin
  658.    Dlina := Isx^.Dlina;
  659.    if Dlina<>0 then MovBit(Isx^.Pmas,Pmas,0,0,Dlina);
  660.   end;
  661.  
  662.   procedure TStr_Bit.Delete (Index,Count: word);
  663.    { ôñá½∩ÑΓ Count í¿Γ ¿º ΓѬπΘÑ⌐ ßΓp«¬¿, ¡áτ¿¡á∩ ß »«º¿µ¿¿ Index }
  664.    { ü¿Γ ¡á »«º¿µ¿¿ Index Γ«ªÑ πñá½∩ÑΓß∩ }
  665.   begin
  666.    if Count+Index >= Dlina then Dlina := Index
  667.                            else begin
  668. {$IFOPT R+}
  669.     if Index >= Dlina then begin
  670.        Error_Str_bit := btNeop;   exit   end;
  671. {$ENDIF}
  672.    Dec( Dlina, Count);
  673.    MovBit(Pmas, Pmas, Index+Count, Index, Dlina-Index)
  674.   end                              end;
  675.  
  676. procedure TStr_Bit.ReplaceGrBt(Index, Kol, Value: word); assembler;
  677.  { ôßΓá¡áó½¿óáÑΓ Kol í¿Γ ßΓp«¬¿ (<=8), ¡áτ¿¡á∩ ß »«º¿µ¿¿ Index        }
  678.  {  ó c«ßΓ«∩¡¿∩,«»pÑñѽ∩ѼδÑ »ÑαѼѡ¡«⌐ Value                         }
  679. asm
  680.         PUSH    ds
  681.         MOV     DX,Value
  682.         lds    di,DWORD PTR ss:[bp+6]   { ÇñpÑß ¡áτá½á ßΓpπ¬Γπpδ ñá¡¡δσ}
  683.         lds    si,DWORD PTR [di+6]      { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  684.         MOV     AX,Index
  685.         shr     ax,1
  686.         shr     ax,1
  687.         shr     ax,1
  688.         ADD     SI,AX        { ÇñpÑß ¡áτá½á íá⌐Γá ºá¼Ñ¡∩Ѽδσ í¿Γ }
  689.         MOV     CX,Index
  690.         and     cl,7
  691.         mov     ax,[si]
  692.         ror     ax,cl     { äá¡¡δÑ óδα«ó¡Ñ¡δ ¡á úαá¡¿µπ íá⌐Γá }
  693.         mov     di,Kol
  694. @csd:   SHR     dl,1
  695.         RCR     ax,1
  696.         dec     di
  697.         JNZ     @csd      { Kol í¿Γ »ÑαÑñá¡« }
  698.         mov     di,Kol
  699. @cvz:   ROL     ax,1
  700.         dec     di
  701.         JNZ     @cvz      { Kol í¿Γ ó«ßΓá¡«ó½Ñ¡« }
  702.         ROL     ax,cl     { é«ºóαáΓ óßÑσ »«º¿µ¿⌐ }
  703.         mov     [si],AX   { çỿß∞ ñá¡¡δσ }
  704.         POP     ds
  705. end;
  706.  
  707. procedure TStr_Bit.BitDisplase (Zn: byte);               assembler;
  708.  { ÄßπΘÑßΓó½∩ÑΓ óßΓáó¬π í¿Γá Zn ó ¡π½Ñóπε »«º¿µ¿ε í¿Γ«ó«⌐ »«ß½Ññ-Γ¿ }
  709.  { ( óßÑ «ßΓá½∞¡δÑ í¿Γδ »«ß½Ññ«óáΓѽ∞¡«ßΓ¿ ßñó¿úáεΓß∩ ¡á 1 í¿Γ )    }
  710.  { »«ß½Ññ¡¿⌐ í¿Γ »«ß½Ññ«óáΓѽ∞¡«ßΓ¿ πñá½∩ÑΓß∩                       }
  711.  { ( «»Ñαᵿ∩ ¡Ñ ¿º¼Ñ¡∩ÑΓ αẼÑα «íαáíáΓδóáѼ«⌐ í¿Γ«ó«⌐ ßΓ᫬¿ )    }
  712. asm
  713.         MOV     DL,Zn     { ç¡áτÑ¡¿Ñ óßΓáó½∩Ѽ«ú« í¿Γá }
  714.         les     si,DWORD PTR ss:[bp+6]  { ÇñpÑß ¡áτá½á ßΓpπ¬Γπpδ ñá¡¡δσ}
  715.         MOV     CX,es:[si]              { ù¿ß½« í¿Γ ó ßΓα«¬Ñ           }
  716.         les     di,DWORD PTR es:[si+6]  { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  717.         ADD     CX,7
  718.         shr     CX,1
  719.         shr     CX,1
  720.         shr     CX,1      { ù¿ß½« íá⌐Γ ó í¿Γ«ó«⌐ »«ß½Ññ«óáΓѽ∞¡«ßΓ¿ }
  721.         JZ      @NetDan
  722.         CLD             { ôßΓá¡«ó¿Γ∞ ¡á»αáó½Ñ¡¿Ñ ¿º¼Ñ¡Ñ¡¿∩ ¿¡ñѬ߫ó }
  723.         SHR     DL,1      { ôßΓá¡«ó¿Γ∞ Σ½áú »ÑαÑ¡«ßá (0 í¿Γ) }
  724. @sdv:   MOV     AL,es:[di]
  725.         RCL     AL,1
  726.         STOSB             { çỿß∞ ñá¡¡δσ }
  727.         LOOP    @sdv
  728. @NetDan:
  729. end;
  730.  
  731. procedure TStr_Bit.LastBitDisplase (Zn: byte);           assembler;
  732.  { ÄßπΘÑßΓó½∩ÑΓ óßΓáó¬π í¿Γá Zn ó »«ß½Ññ¡εε »«º¿µ¿ε í¿Γ«ó«⌐ »«ß½Ññ-Γ¿ }
  733.  { ( óßÑ «ßΓá½∞¡δÑ í¿Γδ »«ß½Ññ«óáΓѽ∞¡«ßΓ¿ ßñó¿úáεΓß∩ ¡á 1 í¿Γ )      }
  734.  { »Ñαóδ⌐ (¿¡ñѬߠ= 0) í¿Γ »«ß½Ññ«óáΓѽ∞¡«ßΓ¿ πñá½∩ÑΓß∩               }
  735.  { ( «»Ñαᵿ∩ ¡Ñ ¿º¼Ñ¡∩ÑΓ αẼÑα «íαáíáΓδóáѼ«⌐ í¿Γ«ó«⌐ ßΓ᫬¿ )      }
  736. ASM
  737.      les    di,DWORD PTR ss:[bp+6]   { ÇñpÑß ¡áτá½á ßΓpπ¬Γπpδ ñá¡¡δσ}
  738.      mov    CX,es:[di]               { ä½¿¡á ßΓ᫬¿ í¿Γ }
  739.      SUB    CX,1                     { ì«¼Ñα »«ß½Ññ¡Ñú« í¿Γá }
  740.      JB     @NetDann                 { é ßΓα«¬Ñ ¡Ñ ß«ñÑনΓß∩ ñá¡¡δσ }
  741.      CLD             { ôßΓá¡«ó¿Γ∞ ¡á»αáó½Ñ¡¿Ñ ¿º¼Ñ¡Ñ¡¿∩ ¿¡ñѬ߫ó }
  742.      MOV    DL,CL
  743.      les    di,DWORD PTR es:[di+6]   { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  744.      SHR    CX,1
  745.      SHR    CX,1
  746.      SHR    CX,1                     { è«½¿τÑßΓó« »ÑαÑßδ½áѼδσ íá⌐Γ }
  747.      JZ    @OdinByte
  748. @SdNach:        { û¿¬½ »ÑαÑß佬¿ ñá¡¡δσ ß« ßñó¿ú«¼ }
  749.        MOV  AX,es:[di]
  750.        SHR  AX,1
  751.        STOSB
  752.        LOOP @SdNach
  753. @OdinByte:       { Äíαáí«Γ¬á »«ß½Ññ¡Ñú« íá⌐Γá }
  754.         mov     AL,Zn
  755.         AND     DL,00000111b
  756.         JZ      @1bit
  757.         mov     AH,AL          { ç¡áτÑ¡¿Ñ óßΓáó½∩Ѽ«ú« í¿Γá  }
  758.         mov     AL,es:[di]     { çáúpπº¬á ¿ßσ«ñ¡«ú« º¡áτÑ¡¿∩ }
  759.         mov     CL,DL
  760.         INC     CL
  761.         ror     AL,cl
  762.         shr     ax,1
  763.         rol     al,cl
  764. @1bit:  stosb
  765. @NetDann:
  766. END;
  767.  
  768. procedure TStr_Bit.Replace (Dopoln : PStr_Bit; Index: word);
  769.  { çá¼Ñ¡∩ÑΓ í¿Γδ ΓѬπΘÑ⌐ »ÑαѼѡ¡«⌐,¡áτ¿¡á∩ ß »«º¿µ¿¿ Index,   }
  770.  { ¡á í¿Γδ »ÑαѼѡ¡«⌐ Dopoln                                   }
  771. var Value, Gran, Ostat, Znach : Word;
  772.     Ukaz : Pointer;
  773. begin
  774.  if (Index > Dlina) or (Dopoln^.Dlina = 0) then
  775.    begin       {ìÑóÑα¡δÑ ¿ßσ«ñ¡δÑ ñá¡¡δÑ}
  776.      Error_Str_bit := btGran;     Exit   end;
  777.  Ostat := Index + Dopoln^.Dlina;
  778.  if Ostat > Dlina
  779.   then begin   { è«»¿απѼδÑ í¿Γδ óδσ«ñ∩Γ ºá ΓѬπΘπε úαá¡¿µπ }
  780.    If Ostat > Max_dlina then begin Znach := Max_dlina - Index;
  781.                                    Dlina := Max_dlina                 end
  782.                         else begin Znach := Dopoln^.Dlina;
  783.                                    Dlina := Ostat                     end;
  784.    MovBit(Dopoln^.Pmas, Pmas, 0, Index, Znach);
  785.       end
  786.   else begin
  787.    Gran := (Ostat div 8) * 8;
  788.    If (Dopoln^.Dlina < 8) and (Gran <= Index )
  789.      then begin   { éßÑ ¿º¼Ñ¡∩ѼδÑ í¿Γδ ¡áσ«ñ∩Γß∩ ó «ñ¡«¼ íá⌐ΓÑ }
  790.       Ukaz := Dopoln^.Pmas;
  791.       ASM
  792.       PUSH DS
  793.       lds    si,DWORD PTR Ukaz
  794.       LODSW
  795.       MOV  Znach,AX
  796.       POP  DS
  797.       end;
  798.       ReplaceGrBt ( Index, Dopoln^.Dlina, Znach );
  799.           end
  800.      else begin   { è«»¿απѼδÑ í¿Γδ ºá¼Ñ¡∩εΓ ßπΘÑßΓóπεΘ¿Ñ }
  801.       Znach := Gran - Index;
  802.       MovBit(Dopoln^.Pmas, Pmas, 0, Index, Znach);
  803.       Value := Ostat - Gran;  { è«½¿τÑßΓó« í¿Γ, «ßΓáóΦ¿σß∩ ñ½∩ ºá¼Ñ¡δ (<8 !!!)}
  804.       if Value = 0 Then Exit;
  805.       Znach := Dopoln^.Nomer ( Znach, Value );
  806.       ReplaceGrBt ( Gran, Value, Znach );
  807.   end      end;
  808. end;
  809.  
  810.  
  811.   procedure TStr_Bit.Insert (Dopoln : PStr_bit; Index: word);
  812. {éßΓáó½∩ÑΓ »«ñßΓp«¬π Dopoln ó ΓѬπΘπε ßΓp«¬π,¡áτ¿¡á∩ ß »«º¿µ¿¿ Index}
  813.   var i   : word;
  814.       S_1 : PStr_Bit;
  815.     procedure Povtor_Insert;
  816.     var Perest : pointer;
  817.      begin
  818.      if Index = 0 then begin
  819.        S_1 := New(PStr_bit,Init(Max_dlina));
  820.        dlina := Dopoln^.dlina;
  821.        MovBit(Dopoln^.Pmas,S_1^.Pmas,0,0,dlina);
  822.        MovBit(Pmas,S_1^.Pmas,0,dlina,i);
  823.        inc(dlina,i);    Perest := Pmas;
  824.         Pmas := S_1^.Pmas; S_1^.Pmas := Perest
  825.                        end
  826.                   else begin
  827.        S_1 := New(PStr_Bit,Init(i));   Copy (S_1,Index,i);
  828.        Dlina := Index;   Concat (Dopoln);    Concat (S_1);
  829.                        end;
  830.      Dispose(S_1,Done)
  831.      end;
  832.   begin
  833.   i := Dlina-Index;
  834. {$IFOPT R+}
  835.     if Index > Dlina then begin Error_Str_bit := btNeop;   exit  end;
  836.     if Dlina+ Dopoln^.Dlina > Max_Dlina then begin
  837.        i := Max_dlina - Index;
  838.        Error_Str_bit := btGran;
  839.        if i <= Dopoln^.Dlina then MovBit(Dopoln^.Pmas,Pmas,0,Index,i)
  840.                              else begin
  841.           dec (i , Dopoln^.Dlina);     Povtor_Insert
  842.                                   end;
  843.     dlina := Max_dlina;            exit      end;
  844. {$ENDIF}
  845.    Povtor_Insert
  846.   end;
  847.  
  848.  
  849. procedure Init_zn(Pmas:pointer; zn:byte; Razmer:word);
  850. { Åp«µÑñπpᠺừ½¡∩ÑΓ ¼áßß¿ó Pmas íá⌐ΓἿ ó¿ñá ZN ó ¬«½¿τÑßΓóÑ Razmer}
  851.   near; assembler;
  852. asm
  853.           les     di,Pmas        {Å«½πτ¿Γ∞ áñpÑß pѺπ½∞ΓáΓa}
  854.           mov     cx,Razmer      {諽¿τÑßΓó« íá⌐Γ          }
  855.           mov     al,Zn
  856.   REP     stosb
  857. end;
  858.  
  859.   procedure TStr_Bit.Init_1;
  860.   begin
  861.    Init_zn(Pmas,$FF,Razmer);
  862.    Dlina := Max_dlina
  863.   end;
  864.  
  865.   procedure TStr_Bit.Init_0;
  866.   begin
  867.    Init_zn(Pmas,0,Razmer);
  868.    Dlina := Max_dlina
  869.   end;
  870.  
  871.   procedure TStr_Bit.Init_array (var Ust; Kol : word);
  872.  { ôßΓá¡áó½¿óáÑΓ í¿Γδ ßΓp«¬¿ ó c«ßΓ«∩¡¿∩,«»pÑñѽ∩ѼδÑ »ÑpѼѡ¡«⌐ Ust }
  873.  { ¼ÑΓ«ñ«¼ »ÑpÑ»¿ßδóá¡¿∩ Kol íá⌐Γ »ÑpѼѡ¡«⌐ ó íπΣÑp ßΓp«¬¿ í¿Γ      }
  874.   var i : word;
  875.   begin
  876.    Dlina := Kol * 8;
  877. {$IFOPT R+}
  878.    if Dlina > Max_Dlina Then begin
  879.       Error_Str_bit := btGran;
  880.       Dlina := Max_Dlina     end;
  881. {$ENDIF}
  882.    i := (Dlina + 7) div 8;      Move(Ust, Pmas^, i)
  883.   end;
  884.  
  885. Procedure TStr_Bit.InvBit ( Index : word);
  886.  { ê¡óÑpΓ¿pπÑΓß∩ í¿Γ ßΓp«¬¿ ¡á »«º¿µ¿¿ Index}
  887.   begin
  888.    if Index > dlina then  Error_Str_bit := btGran
  889.                     else  ASM
  890.      les    di,DWORD PTR ss:[bp+6]   { ÇñpÑß ¡áτá½á ßΓpπ¬Γπpδ ñá¡¡δσ}
  891.      les    di,DWORD PTR es:[di+6]   { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  892.       mov     ax,Index
  893.       mov     cl,3
  894.       shr     ax,cl
  895.       add     di,ax
  896.       mov     cx,Index
  897.       and     cl,7
  898.       mov     al,es:[di]
  899.       mov     ah,00000001b
  900.       shl     ah,cl
  901.       xor     al,ah
  902.       stosb
  903.    END;
  904.   end;
  905.  
  906.   procedure TStr_Bit.Init_Mas(var Mas; Kol: word);
  907.  { ôßΓá¡áó½¿óáÑΓ Kol í¿Γ ßΓp«¬¿ ó c«ßΓ«∩¡¿∩,«»pÑñѽ∩ѼδÑ ¼áßß¿ó«¼ Mas }
  908.  { ¬áªñδ⌐ íá⌐Γ ¬«Γ«p«ú« ß«ñÑpª¿Γ bt1 ¿½¿ bt0                          }
  909.   begin
  910.    if Max_dlina >= kol then dlina := Kol
  911.                        else begin
  912.          dlina := Max_dlina;  Error_Str_bit := btGran   end;
  913.     Upak ( @Mas, Pmas, dlina);
  914.   end;
  915.  
  916.   function TStr_Bit.Val_Mas(var Mas; Kol: word) : word;
  917.  { ôßΓá¡áó½¿óáÑΓ Kol íá⌐Γ ¼áßß¿óá Mas ó ß«ßΓ«∩¡¿∩ bt1 ¿½¿ bt0,     }
  918.  { «»pÑñѽ∩ѼδÑ ΓѬπΘÑ⌐ ßΓp«¬«⌐ í¿Γ (pá߻ᬫóá¡¡δ⌐ óáp¿á¡Γ ßΓp«¬¿) }
  919.  { ¬«½¿τÑßΓó« »«½πτÑ¡¡δσ φ½Ñ¼Ñ¡Γ«ó óδñáÑΓß∩ ó ¬áτÑßΓóÑ pѺ-Γá      }
  920.  var i : word;
  921.   begin
  922.    if dlina > kol then i := kol
  923.                   else i := dlina;
  924.       ASM
  925.           mov     dx,ds        { æ«σpá¡¿Γ∞ DS }
  926.      lds    di,DWORD PTR ss:[bp+6]   { ÇñpÑß ¡áτá½á ßΓpπ¬Γπpδ ñá¡¡δσ}
  927.      lds    si,DWORD PTR [di+6]      { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  928.           les     di,mas       { Å«½πτ¿Γ∞ áñpÑß ¼áßß¿óá pѺπ½∞ΓáΓá}
  929.           mov     bx,Kol
  930.           xor     al,al
  931.           cld
  932. @povt:    mov     cx,8
  933.           mov     ah,[si]
  934. @slel:    shr     ax,1
  935.           rol     al,1
  936.           stosb
  937.           dec     bx
  938.           jz      @kon
  939.           loop    @slel
  940.           inc     si
  941.           jmp     @povt
  942. @kon:     mov     ds,dx      {  é«ßßΓá¡«ó½Ñ¡¿Ñ DS }
  943.       END;
  944.    Val_Mas := i;
  945.   end;
  946.  
  947. procedure PBit( M: pointer ; Nach : word; Zn : byte);       assembler;
  948.  { öπ¡¬µ¿∩ óδñѽ∩ÑΓ í¿Γ ¿º ¼áßß¿óá ß áñpÑß«¼ M ß í¿Γá N }
  949.       ASM
  950.         les     di,M          { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿ }
  951.         mov     ax,Nach       { H«¼Ñp í¿Γá                  }
  952.         mov     cl,3
  953.         shr     ax,cl
  954.         add     di,ax
  955.         mov     al,es:[di]     { çáúpπº¬á ¿ßσ«ñ¡«ú« º¡áτÑ¡¿∩}
  956.         mov     cx,Nach
  957.         and     cl,00000111b
  958.         ror     al,cl
  959.         mov     ah,Zn
  960.         shr     ax,1
  961.         inc     cl
  962.         rol     al,cl
  963.         stosb
  964.       END;
  965.  
  966.   procedure TStr_Bit.PutBit(Nach:word; Zn: byte);
  967.   { êº¼Ñ¡∩ÑΓ º¡áτÑ¡¿Ñ í¿Γá ΓѬπΘÑ⌐ ßΓp«¬¿, ßΓ«∩ΘÑú« ¡á »«º¿µ¿¿ Nach }
  968.   { ¡á º¡áτÑ¡¿Ñ Zn. ( ü¿Γ ¡á ñá¡¡«⌐ »«º¿µ¿¿ ñ«½ªÑ¡ íδΓ∞ «»pÑñѽѡ)  }
  969.   begin
  970. {$IFOPT R+}
  971.    if (Dlina < Nach) or (Nach > Max_dlina) Then
  972.               begin Error_Str_bit := btGran;  EXIT  end;
  973. {$ENDIF}
  974.    if Dlina = Nach Then inc(Dlina);
  975.    PBit (Pmas, Nach, Zn);
  976.   end;    { TStr_Bit.PutBit }
  977.  
  978.   procedure TStr_Bit.Init_Sim(Ust :string);
  979. {ôßΓá¡áó½¿óáÑΓ í¿Γδ ßΓp«¬¿ ó c«ßΓ«∩¡¿∩,«»pÑñѽ∩ѼδÑ ßΓp«¬«⌐ ß¿¼ó«½«ó}
  980.   var i : word;
  981.   begin
  982.    Dlina := ord(Ust[0]);
  983. {$IFOPT R+}
  984.    if Dlina > Max_Dlina Then begin
  985.       Error_Str_bit := btGran;
  986.       Dlina := Max_Dlina     end;
  987. {$ENDIF}
  988.    if Dlina<>0 then Upak ( @Ust[1], Pmas, Dlina )
  989.   end;
  990.  
  991.   procedure TStr_Bit.Val_array ( var Mass; Kol: word);   assembler;
  992.    { ÅÑpÑßδ½áÑΓ »ÑpóδÑ Kol íá⌐Γ í¿Γ«ó«⌐ ßΓp«¬¿ ó ¼áßß¿ó íá⌐Γ }
  993.    { àß½¿ ΓѬπΘá∩ ñ½¿¡á ßΓp«¬¿ ¼Ñ¡∞ΦÑ pẼÑpá ¼áßß¿óá, Γ«    }
  994.    { ¡Ññ«ßΓáεΘ¿Ñ ñá¡¡δÑ ºá»«½¡∩εΓß∩ ¡π½∩¼¿                   }
  995.      ASM
  996.      push   ds
  997.      lds    si,DWORD PTR ss:[bp+6]   { ÇñpÑß ¡áτá½á ßΓpπ¬Γπpδ ñá¡¡δσ}
  998.      mov    dx,[si]               { è«½¿τÑßΓó« í¿Γ ó í¿Γ«ó«⌐ ßΓp«¬Ñ }
  999.      lds    si,DWORD PTR [si+6]      { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  1000.      les    di,Mass                  { ÇñpÑß ¼áßß¿óá pѺπ½∞ΓáΓá     }
  1001.      cld
  1002.      mov    bx,Kol
  1003.      mov    cx,dx
  1004.      shr    cx,1
  1005.      shr    cx,1
  1006.      shr    cx,1
  1007.      jz     @1byte
  1008.      CMP    cx,bx   { ä½¿¡á ßΓp«¬¿ ¼Ñ¡∞ΦÑ pẼÑp¡«ßΓ¿ ¼áßß¿óá}
  1009.      jb     @obr
  1010.  
  1011.      mov    cx,bx    { ìÑΓ }
  1012.  rep movsb
  1013.      jmp    @kon
  1014. @obr:
  1015.      sub    bx,cx    { ñá }
  1016.  rep movsb           { »ÑpÑßδ½¬á º¡áτáΘ¿σ í¿Γ ßΓp«¬¿ }
  1017. @1byte:
  1018.      mov    ch,dl    { Äípáí«Γ¬á »«ß½Ññ¡Ñú« íá⌐Γá í¿Γ«ó«⌐ ßΓp«¬¿ }
  1019.      lodsb
  1020.      and    ch,7
  1021.      mov    cl,8
  1022.      sub    cl,ch
  1023.      shl    al,cl
  1024.      shr    al,cl
  1025.      stosb          { ÅÑpÑßδ½¬á «ßΓáΓ¬á ßΓp«¬¿ 0-7 í¿Γ }
  1026.      dec    bx
  1027.      jz     @kon
  1028.      mov    cx,bx
  1029.      xor    ax,ax
  1030.  rep stosb           { «í¡π½Ñ¡¿Ñ ¡Ñº¡áτáΘ¿σ í¿Γ ¼áßß¿óá }
  1031. @kon:
  1032.      pop    ds
  1033.      END;
  1034.  
  1035. procedure TStr_Bit.InvStrBit;  assembler;
  1036.  { ê¡óÑαΓ¿απÑΓ í¿Γ«óπε »«ß½Ññ«óáΓѽ∞¡«ßΓ∞. èáªñá∩ "1" ßΓá¡«ó¿Γß∩ "0" ¿ ¡á«í«α«Γ }
  1037. ASM
  1038.      push    ds
  1039.      lds    si,DWORD PTR ss:[bp+6]   { ÇñpÑß ¡áτá½á ßΓpπ¬Γπpδ ñá¡¡δσ}
  1040.      MOV    CX,[si]                  { ÆѬπΘá∩ ñ½¿¡á í¿Γ«ó«⌐ ßΓ᫬¿ }
  1041.      lds    si,DWORD PTR [si+6]      { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  1042.      OR      CX,CX
  1043.      JZ      @EndInvStrBit    { ä½¿¡á ¡Ñ ¼«ªÑΓ íδΓ∞ αáó¡«⌐ 0 }
  1044.      ADD     CX,7
  1045.      SHR     CX,1
  1046.      SHR     CX,1
  1047.      SHR     CX,1   { íá⌐Γ }
  1048. @InvStr: NOT   BYTE PTR [SI]
  1049.          INC   SI
  1050.          LOOP  @InvStr
  1051. @EndInvStrBit: POP    DS
  1052. END;
  1053.  
  1054. function TStr_Bit.Nomer(Nach : word; dln: byte) : word;
  1055.  { öπ¡¬µ¿∩ óδñѽ∩ÑΓ c½«ó« ß í¿Γá Nach    }
  1056.  { é ß½«óÑ ºá»«½¡Ñ¡δ DLN ¼½áñΦ¿σ í¿Γ     }
  1057. begin
  1058. {$IFOPT R+}
  1059.    if Dlina < Nach + dln Then Error_Str_bit := btGran;
  1060. {$ENDIF}
  1061.    Nomer := Isub(Pmas,Nach,dln);
  1062. end;
  1063.  
  1064.   constructor TBitFile.Init(ASizeMax: Word; Size: word);
  1065.   { ASizeMax - ¼á¬ß¿¼á½∞¡á∩ ñ½¿¡á ßΓp«¬¿ ó í¿Γáσ }
  1066.   { Size  - pẼÑp »p«¼ÑªπΓ«τ¡«ú« íπΣÑpá ñ½∩ τΓÑ¡¿∩ ñá¡¡δσ ¿º Σá⌐½á }
  1067.   var Kol: word;
  1068. begin
  1069.   OrderBitRevers := False;
  1070.   RegOtkr := 0;
  1071.   TStr_Bit.Init(ASizeMax);
  1072.     if Size > 7680 then RazmBuf := 7680
  1073.                    else RazmBuf := Size;
  1074.     if RazmBuf < razmer then RazmBuf := razmer;
  1075.   GetMem(PBuff,RazmBuf);
  1076.  end;
  1077.  
  1078. {$L OrderBit.obj}
  1079. Procedure OrderBit(Mreor : pointer; KolBayt : integer);     external;
  1080. { Åα«µÑñπαá ¿º¼Ñ¡∩ÑΓ »«α∩ñ«¬ ß½Ññ«óá¡¿∩ í¿Γ ó ¼áßß¿óÑ (»ÑαÑó«α«Γ íá⌐Γá)}
  1081.  
  1082.  destructor TBitFile.Done;
  1083.  begin
  1084.   if RegOtkr <> 0 Then CloseBitFile;
  1085.   FreeMem(PBuff,RazmBuf);
  1086.   TStr_Bit.Done
  1087.  end;
  1088.  
  1089.  function TBitFile.OpenBitFile (Name: string; Mode: word):word;
  1090.   { ÄΓ¬αδΓ¿Ñ Σá⌐½á ñ½∩ «íαáí«Γ¬¿ ó í¿Γ«ó«¼ ó¿ñÑ                      }
  1091.   { Name  - ¿¼∩ Σá⌐½á, ß ¬«Γ«pδ¼ íπñπΓ »p«¿ºó«ñ¿Γ∞ß∩ «»Ñpᵿ¿ «í¼Ñ¡á }
  1092.   { Mode  - pѪ¿¼ «Γ¬pδΓ¿∩ Σá⌐½á                                     }
  1093.   var Kol: word;
  1094.  begin
  1095. {$I-}
  1096.   Position := 0;    PosBuf := 0;
  1097.   assign (FileDis, Name);
  1098.   FileMode := 0;   { Äíαáí«Γ¬á Σá⌐½«ó ß áΓα¿íπΓ«¼ Γ«½∞¬« ñ½∩ τΓÑ¡¿∩ }
  1099.    case  Mode of
  1100.     $3C00 {btCreate } : Rewrite(FileDis,1);
  1101.     $3D00 {btOpenRead}: Reset(FileDis,1);
  1102.    else begin Writeln('ÄΦ¿í¬á ºáñá¡¿∩ »áαá¼ÑΓα«ó »α¿ «Γ¬αδΓ¿¿ Σá⌐½á');
  1103.               Halt(2)                                                 end
  1104.    end; { case }
  1105. {$I+}
  1106.   if IOResult <> 0 then begin  { Ä»Ñpᵿ∩ «Γ¬pδΓ¿∩ Σá⌐½á ¡Ñ óδ»«½¡¿½áß∞ }
  1107.      Writeln('ÄΦ¿í¬á «Γ¬αδΓ¿∩ Σá⌐½á '+ Name);
  1108.      Error_File_bit := btErrOtkr;
  1109.      OpenBitFile := btErrOtkr;
  1110.      Exit               end;
  1111.     if Mode = btOpenRead then begin
  1112. {$I-}
  1113.        PosMax := FileSize(FileDis);
  1114.        BlockRead(FileDis,PBuff^,RazmBuf, Kol);
  1115. {$I+}
  1116.        if IOResult <> 0 then begin  { Ä»Ñpᵿ∩ «Γ¬pδΓ¿∩ Σá⌐½á ¡Ñ óδ»«½¡¿½áß∞ }
  1117.           Writeln('ÄΦ¿í¬á »α¿ τΓÑ¡¿¿ ñá¡¡δσ ¿º Σá⌐½á '+ Name);
  1118.           Error_File_bit := btOchBB;
  1119.           OpenBitFile := btErrOtkr;
  1120.           Exit               end;
  1121.        PosBufMax := Kol * 8;
  1122.        PosMax := PosMax * 8   { ä½¿¡á Σá⌐½á ó í¿Γáσ }
  1123.                               end
  1124.                          else begin
  1125.        PosMax := 0;   PosBufMax := RazmBuf * 8
  1126.                               end;
  1127.   RegOtkr := Mode;
  1128.   Error_File_bit := 0;
  1129.   OpenBitFile := btOk;
  1130.  end;
  1131.  
  1132.  function TBitFile.CloseBitFile:word;
  1133.   { çá¬αδΓ¿Ñ «íαáíáΓδóáѼ«ú« Σá⌐½á  }
  1134.  begin
  1135.   if RegOtkr = btCreate then begin
  1136.     dlina := (PosBuf + 7) div 8;
  1137. {$I-}
  1138.     if dlina <> 0 then begin
  1139.        if OrderBitRevers then OrderBit(PBuff,dlina);
  1140.        BlockWrite(FileDis,PBuff^,Dlina);
  1141.                        end;
  1142. {$I+}
  1143.     if IOResult <> 0 then
  1144.       begin writeln ('ÄΦ¿í¬á »p¿ ºá»¿ß¿ ¬«¡µá Σá⌐½á');
  1145.             CloseBitFile := btOchBB                     end
  1146.                               end;
  1147.   Close(FileDis);
  1148.   RegOtkr := 0;        CloseBitFile := btOk
  1149.  end;
  1150.  
  1151. procedure TBitFile.ChangeOrderBit;
  1152. begin
  1153.   OrderBitRevers := True;
  1154.   if RegOtkr = btOpenRead then OrderBit(PBuff,RazmBuf);
  1155. end;
  1156.  
  1157. function TBitFile.SizeOfFile : longint;
  1158.    { é«ºópáΘáÑΓ ΓѬπΘ¿⌐ pẼÑp Σá⌐½á ó í¿Γáσ }
  1159.  begin  SizeOfFile := PosMax;
  1160.  end;
  1161.  
  1162. function TBitFile.ReadStr(Count:word): word;
  1163.    { çừ½¡∩εΓß∩ Count í¿Γ ßΓp«¬¿ º¡áτÑ¡¿∩¼¿ ¿º Σá⌐½á }
  1164.   var i, NK : word;
  1165.   begin
  1166.   if RegOtkr = 0 Then begin {Å«»δΓ¬á «íαáí«ΓáΓ∞ ñá¡¡δÑ ¿º ¡Ñ«Γ¬α.Σá⌐½á}
  1167.     Writeln(ErrObr);  Halt(1);
  1168.                       end;
  1169. {$IFOPT R+}
  1170.    if Count > Max_dlina Then begin
  1171.        Error_Str_bit := btGran;   dlina := Max_dlina    end
  1172.                         else dlina := Count;
  1173. {$ELSE}
  1174.    dlina := Count;
  1175. {$ENDIF}
  1176.    if RegOtkr = btOpenRead then
  1177.         if Position >= PosMax then ReadStr := btEndFile          {1}
  1178.                               else begin                         {1}
  1179.            {.........................................................}
  1180.           if PosBuf + dlina >= PosBufMax then begin               {.2}
  1181.            {--------------------------------------------------------}
  1182.             i := PosBufMax - PosBuf;
  1183.             MovBit(PBuff,Pmas,PosBuf,0,i);
  1184. {$I-}
  1185.             BlockRead(FileDis,PBuff^,RazmBuf,NK);
  1186.             if OrderBitRevers then OrderBit(PBuff,RazmBuf);
  1187. {$I+}
  1188.             PosBufMax := NK * 8;     PosBuf := dlina - i;
  1189.             if PosBuf > PosBufMax then PosBuf := PosBufMax;
  1190.             if IOResult <> 0 then begin PosBuf:= 0;
  1191.                                         Error_File_bit := btOchBB;
  1192.                                         ReadStr := btOchBB;
  1193.                                         PosBufMax := 0          end
  1194.                              else
  1195.                       if Nk <> 0 then MovBit(PBuff,Pmas,0,i,PosBuf)
  1196.                                  else ReadStr := btGran;
  1197.             dlina := i + PosBuf              end
  1198.            {--------------------------------------------------------}
  1199.                                         else begin               {.2}
  1200.             MovBit(PBuff, Pmas, PosBuf, 0, Dlina);               {. 3}
  1201.             inc(PosBuf,dlina)                end;                {. 3}
  1202.           inc(Position,dlina);                                   {.2}
  1203.           ReadStr := btOk          end                           {1}
  1204.            {.........................................................}
  1205.                            else begin
  1206.          { Å«»δΓ¬á τΓÑ¡¿∩ ¿º Σá⌐½á «Γ¬pδΓ«ú« ñ½∩ ºá»¿ß¿ }
  1207.          dlina := 0;    ReadStr := btNevReg
  1208.   end                           end;
  1209.  
  1210. function TBitFile.ReadNomer(Dln:byte): word;
  1211.  { öπ¡¬µ¿∩ ßτ¿ΓδóáÑΓ ¿º Σá⌐½á DLN í¿Γ ¿ óδñáÑΓ ó ¬áτÑßΓóÑ αѺ-Γá }
  1212. var i, NK, Rez : word;
  1213.   begin
  1214.   if Dln > 16 then begin Error_File_bit := btGran;
  1215.                          Exit              end;
  1216.   if RegOtkr = 0 Then begin {Å«»δΓ¬á «íαáí«ΓáΓ∞ ñá¡¡δÑ ¿º ¡Ñ«Γ¬α.Σá⌐½á}
  1217.     Writeln(ErrObr);  Halt(1);
  1218.                       end;
  1219.   if RegOtkr = btOpenRead then
  1220.      if Position >= PosMax then Error_File_bit := btEndFile
  1221.                            else begin                         {1}
  1222.            {.........................................................}
  1223.           if PosBuf + Dln >= PosBufMax then begin               {.2}
  1224.            {--------------------------------------------------------}
  1225.             i := PosBufMax - PosBuf;
  1226.             Rez := Isub(PBuff,PosBuf,i);
  1227. {$I-}
  1228.             BlockRead(FileDis,PBuff^,RazmBuf,NK);
  1229.             if OrderBitRevers then OrderBit(PBuff,RazmBuf);
  1230. {$I+}
  1231.             PosBufMax := NK * 8;     PosBuf := Dln - i;
  1232.             if PosBuf > PosBufMax then PosBuf := PosBufMax;
  1233.             if IOResult <> 0 then begin PosBuf:= 0;
  1234.                                         Error_File_bit := btOchBB;
  1235.                                         PosBufMax := 0          end
  1236.                                   else
  1237.                       if Nk <> 0 then MovBit(PBuff,@Rez,0,i,PosBuf)
  1238.                                  else Error_File_bit := btGran;
  1239.                                              end
  1240.            {--------------------------------------------------------}
  1241.                                         else begin               {.2}
  1242.             Rez := Isub(PBuff,PosBuf,Dln);
  1243.             inc(PosBuf,Dln)                  end;                {. 3}
  1244.           inc(Position,Dln);                                     {.2}
  1245.           ReadNomer := Rez          end                           {1}
  1246.            {.........................................................}
  1247.            else  { Å«»δΓ¬á τΓÑ¡¿∩ ¿º Σá⌐½á «Γ¬pδΓ«ú« ñ½∩ ºá»¿ß¿ }
  1248.          Error_File_bit := btNevReg
  1249.  end;
  1250.  
  1251. function TBitFile.ReadBit: Byte;
  1252.    { ùΓÑ¡¿Ñ í¿Γá ¿º Σá⌐½á, Ñß½¿ αѺπ½∞ΓáΓ >1 => «Φ¿í¬á óδ»-∩ «»Ñαᵿ¿ }
  1253. var NK : word;
  1254. begin
  1255.  if RegOtkr = 0 Then begin {Å«»δΓ¬á «íαáí«ΓáΓ∞ ñá¡¡δÑ ¿º ¡Ñ«Γ¬α.Σá⌐½á}
  1256.     Writeln(ErrObr);  Halt(1);
  1257.                       end;
  1258.  if RegOtkr = btOpenRead then
  1259.    if Position >= PosMax
  1260.     then ReadBit := btEndFile
  1261.     else begin
  1262.       if PosBuf >= PosBufMax then begin
  1263. {$I-}                                { óó«ñ ñá¡¡δσ ó »α«¼ÑªπΓ«τ¡δ⌐ íπΣÑα }
  1264.         BlockRead(FileDis,PBuff^,RazmBuf,NK);
  1265.         if OrderBitRevers then OrderBit(PBuff,RazmBuf);
  1266. {$I+}
  1267.         PosBufMax := NK * 8;     PosBuf := 0;
  1268.         if IOResult <> 0 then begin PosBufMax := 0;
  1269.                                     ReadBit := btOchBB;
  1270.                                     Exit              end
  1271.                                     end;
  1272.       inc(Position);
  1273.       inc(PosBuf);
  1274.       ReadBit := RBit(PBuff,PosBuf-1);
  1275.          end
  1276.     else ReadBit := btNevReg { Å«»δΓ¬á τΓÑ¡¿∩ ¿º Σá⌐½á «Γ¬pδΓ«ú« ñ½∩ ºá»¿ß¿ }
  1277. end;
  1278.  
  1279. function TBitFile.WriteStr: word;
  1280.    { ü¿Γ«óá∩ ßΓp«¬á ºá»¿ßδóáÑΓß∩ ó ¬«¡Ñµ Σá⌐½á }
  1281.   var Kol, i, NK : word;
  1282.   begin
  1283.   if RegOtkr = 0 Then begin {Å«»δΓ¬á «íαáí«ΓáΓ∞ ñá¡¡δÑ ¿º ¡Ñ«Γ¬α.Σá⌐½á}
  1284.     Writeln(ErrObr);  Halt(1);
  1285.                       end;
  1286.    if RegOtkr = btCreate then begin
  1287.       inc(Position,dlina);  { ÆѬπΘá∩ »«º¿µ¿∩ í¿Γá ó Σá⌐½Ñ}
  1288.       inc(PosMax,dlina);    { ÉẼÑp Σá⌐½á }
  1289.       if PosBuf + Dlina >= PosBufMax then begin
  1290.       { ä½¿¡á í¿Γ«ó«⌐ ßΓp«¬¿ í«½∞ΦÑ «ßΓáΓ¬á íπΣÑpá óδó«ñá}
  1291.          Nk := btOk;
  1292.          kol := PosBufMax - PosBuf;
  1293.          MovBit(Pmas,PBuff,0,PosBuf,Kol);
  1294. {I-}
  1295.          if OrderBitRevers then OrderBit(PBuff,RazmBuf);
  1296.          BlockWrite(FileDis,PBuff^,RazmBuf);
  1297. {$I+}
  1298.          if IOResult <> 0  then Nk := btOchBB;
  1299.          PosBuf := Dlina - Kol;
  1300.          MovBit(Pmas,PBuff,Kol,0,PosBuf)
  1301.                                          end
  1302.                                     else begin
  1303.          MovBit(Pmas,PBuff,0,PosBuf,Dlina);
  1304.          inc(PosBuf,Dlina);     Nk := btOk
  1305.                               end        end
  1306.                          else Nk := btNevReg;
  1307.    { Äí¡π½Ñ¡¿Ñ ñ½¿¡δ óδóÑñÑ¡¡«⌐ ßΓp«¬¿ }
  1308.    WriteStr := Nk
  1309.   end;
  1310.  
  1311. function TBitFile.WriteBit(Zn:byte): word;
  1312.    { ü¿Γ Zn ºá»¿ßδóáÑΓß∩ ó ¬«¡Ñµ Σá⌐½á }
  1313. var NK : word;     AdrBuf : pointer;
  1314.   begin
  1315.   Nk := btNevReg;
  1316.   if RegOtkr = 0 Then begin {Å«»δΓ¬á «íαáí«ΓáΓ∞ ñá¡¡δÑ ¿º ¡Ñ«Γ¬α.Σá⌐½á}
  1317.     Writeln(ErrObr);  Halt(1);
  1318.                       end;
  1319.    if RegOtkr = btCreate then begin
  1320.       inc(Position);  { ÆѬπΘá∩ »«º¿µ¿∩ í¿Γá ó Σá⌐½Ñ}
  1321.       inc(PosMax);    { ÉẼÑp Σá⌐½á }
  1322.       Nk := PosBuf;    AdrBuf := PBuff;
  1323.       ASM               { çỿß∞ í¿Γá ó íπΣÑα }
  1324.         les     di,DWORD PTR AdrBuf   { ÇñpÑß ¡áτá½á í¿Γ«ó«⌐ ßΓp«¬¿  }
  1325.         mov     ax,Nk        { H«¼Ñp í¿Γá                }
  1326.         mov     cl,3
  1327.         shr     ax,cl
  1328.         add     di,ax
  1329.         mov     al,es:[di]     { çáúpπº¬á ¿ßσ«ñ¡«ú« º¡áτÑ¡¿∩}
  1330.         mov     cx,Nk
  1331.         and     cl,00000111b
  1332.         ror     al,cl
  1333.         mov     ah,Zn
  1334.         shr     ax,1
  1335.         inc     cl
  1336.         rol     al,cl
  1337.         stosb
  1338.       END;
  1339.       inc(PosBuf);    { æ¼ÑΘÑ¡¿Ñ »«º¿µ¿¿ ó íπΣÑαÑ}
  1340.       Nk := btOk;
  1341.       if PosBuf = PosBufMax then begin  { üπΣÑp óδó«ñá »«½¡δ⌐ }
  1342. {I-}
  1343.          if OrderBitRevers then OrderBit(PBuff, RazmBuf);
  1344.          BlockWrite(FileDis,PBuff^, RazmBuf);
  1345. {$I+}
  1346.          if IOResult <> 0  then Nk := btOchBB;
  1347.          PosBuf := 0;
  1348.                               end   end;
  1349.    WriteBit := Nk
  1350. end;
  1351.  
  1352. function TBitFile.WriteNomer (ZN:word; Dln: byte): word;
  1353.    { î½áñΦ¿Ñ Dln αáºα∩ñ«ó »ÑαѼѡ¡«⌐ Zn ºá»¿ßδóáεΓß∩ ó ¬«¡Ñµ Σá⌐½á }
  1354.   var Kol, i, NK : word;
  1355.   begin
  1356.   if RegOtkr = 0 Then begin {Å«»δΓ¬á «íαáí«ΓáΓ∞ ñá¡¡δÑ ¿º ¡Ñ«Γ¬α.Σá⌐½á}
  1357.     Writeln(ErrObr);  Halt(1);
  1358.                       end;
  1359.   if Dln > 16 then begin WriteNomer := btGran;
  1360.                          Exit              end;
  1361.    if RegOtkr = btCreate then begin
  1362.       inc(Position,Dln);  { ÆѬπΘá∩ »«º¿µ¿∩ í¿Γá ó Σá⌐½Ñ}
  1363.       inc(PosMax,Dln);    { ÉẼÑp Σá⌐½á }
  1364.       if PosBuf + Dln >= PosBufMax then begin
  1365.       { ä½¿¡á »ÑαѼѡ¡«⌐ í«½∞ΦÑ «ßΓáΓ¬á íπΣÑpá óδó«ñá}
  1366.          Nk := btOk;
  1367.          kol := PosBufMax - PosBuf;
  1368.          MovBit(@ZN,PBuff,0,PosBuf,Kol);
  1369. {I-}
  1370.          if OrderBitRevers then OrderBit(PBuff,RazmBuf);
  1371.          BlockWrite(FileDis,PBuff^,RazmBuf);
  1372. {$I+}
  1373.          if IOResult <> 0  then Nk := btOchBB;
  1374.          PosBuf := Dln - Kol;
  1375.          MovBit(@ZN,PBuff,Kol,0,PosBuf)
  1376.                                          end
  1377.                                     else begin
  1378.          MovBit(@Zn,PBuff,0,PosBuf,Dln);
  1379.          inc(PosBuf,Dln);     Nk := btOk
  1380.                               end        end
  1381.                          else Nk := btNevReg;
  1382.    { Äí¡π½Ñ¡¿Ñ ñ½¿¡δ óδóÑñÑ¡¡«⌐ ßΓp«¬¿ }
  1383.    WriteNomer := Nk
  1384.   end;
  1385.  
  1386.   function TBitFile.NomTekBi: longint;
  1387.  { é«ºóαáΘáÑΓß∩ áíß«½εΓ¡δ⌐ ¡«¼Ñα »Ñαó«ú« í¿Γá ΓѬπΘÑ⌐ í¿Γ«ó«⌐ ßΓ᫬¿ }
  1388.   begin
  1389.    NomTekBi := Position - Dlina;
  1390.   end;
  1391.  
  1392.   function TBitFile.SeekStr(Polog : longint): word;
  1393.    { ôßΓá¡«ó¬á ΓѬπΘÑ⌐ »«º¿µ¿¿ ó Σá⌐½Ñ ¡á í¿Γ«óδ⌐ φ½Ñ¼Ñ¡Γ Pos }
  1394.   var BitPol : longint;
  1395.       Nk     : word;
  1396.   begin
  1397. if RegOtkr = btOpenRead then
  1398.   if Polog < PosMax Then
  1399.   begin { Å«º¿µ¿∩ ¡Ñ óδσ«ñ¿Γ ºá úpá¡¿µδ Σá⌐½á }
  1400.    BitPol := Polog - Position + PosBuf;
  1401.      if (BitPol < 0) or (BitPol > PosBufMax)
  1402.         then begin { æτ¿ΓáΓ∞ ¡«óδ⌐ í½«¬ ñá¡¡δσ  }
  1403.           BitPol := (Polog div (RazmBuf*8)) * RazmBuf;
  1404. {I-}
  1405.           Seek(FileDis,BitPol);
  1406.          if IOResult <> 0  then Error_Str_bit := btOchBB
  1407.                            else begin
  1408.             BlockRead(FileDis,PBuff^,RazmBuf,NK);
  1409.             if OrderBitRevers then OrderBit(PBuff,RazmBuf);
  1410. {$I+}
  1411.    if IOResult = 0 then begin  PosBufMax := NK * 8;
  1412.                                PosBuf := Polog - BitPol * 8   end
  1413.                    else  Error_Str_bit := btOchBB
  1414.              end                end
  1415.         else PosBuf := BitPol; { Cñó¿¡πΓ∞ »«º¿µ¿ε ó¡πΓp¿ íπΣÑpá }
  1416.    Position := Polog; SeekStr := btOk
  1417.   end
  1418.   else SeekStr := btEndFile
  1419. else SeekStr := btNevReg
  1420.   end;
  1421.  
  1422. end.
  1423.