PAS

PAS/!!!Utilzz/setYear.pas

@@ -0,0 +1,19 @@
+uses DOS;
+var
+ CurTime : longint;
+ DOW,Year: word;
+ Timing  : FILE;
+ TD      : DateTime;
+
+begin
+  Assign(Timing,'P:\timer');
+  {$I-}
+   Reset(Timing);
+   if IOResult <> 0 then Halt(255);
+  {$I+}
+  GetFTime(Timing,CurTime);
+  Close(Timing);
+  UnpackTime(CurTime,TD);
+  GetDate(Year,TD.Month,TD.Day,Dow);
+  SetDate(TD.Year,TD.MONTH,TD.DAY);
+end.

PAS/!Other/25_.pas

@@ -0,0 +1,82 @@
+Uses CRT;
+type
+ PList = ^TList;
+ TList = record
+   num  : real;
+   Next : PList;
+ end;
+
+
+function p26(L:PList):boolean;
+var
+ i,j,k : PList;
+begin
+  p26:=False;
+  i:=L;
+  while i <> nil do
+  begin
+   j:=i^.next;
+   while j <> nil do
+    begin
+      k:=j^.next;
+      while k <> nil do
+      begin
+        if (i^.num = j^.num) and (k^.num = j^.num) then
+        begin
+          p26:=true;
+          exit;
+        end;
+        k:=k^.next;
+      end;
+      j:=j^.next;
+    end;
+   i:=i^.next;
+  end;
+end;{‡ ¤ ­¨¥}
+{---------------------------------}
+
+Function GetList:PList;
+var
+ N,p : PList;
+ cur : real;
+begin
+  WriteLn('‚¢®¤¨â¥ ç¨á« , § ª ­¨ç¨¢ ï 0-¬');
+  read(cur);
+  New(p);
+  p^.num := cur;
+  p^.Next := nil;
+  while cur <> 0 do begin
+   read(cur);
+   New(N);
+   N^.num := cur;
+   N^.Next := p;
+   p:=N;
+  end;
+  GetList := P;
+end;
+
+Procedure WriteList(var L : PList);
+var
+ P : Plist;
+begin
+  p:=L;
+  while p<>nil do begin
+    write(p^.num:0:2,'  ');
+    p:=p^.next;
+  end;
+end;
+
+var
+  List : PList;
+
+begin
+  ClrScr;
+  List := GetList;
+  WriteLn('‘¯¨á®ª â ª®©:');
+  WriteList(List);
+  WriteLn;
+  If p26(List) then
+   writeLn('…áâì í«¥¬¥­âë, ¢áâ¥ç î騥áï ¡®«ìè¥ 2-å à §')
+  else
+   writeLn('�¥â í«¥¬¥­â®¢, ¢áâ¥ç î騥áï ¡®«ìè¥ 2-å à §');
+end.

PAS/!Other/BTREE.PAS

@@ -0,0 +1,77 @@
+type
+  ptree = ^btree;
+  btree = record
+    key : integer;
+    left,right : ptree;
+  end;
+
+Procedure DoWork(tr : ptree);
+begin
+end;{DoWork}
+{-----------------}
+procedure LRootR(var tr : ptree);
+begin
+  if tr <> nil then
+   begin
+    LrootR(tr^.left);
+    DoWork(tr);
+    LrootR(tr^.right);
+   end;
+end;
+
+procedure RootRL(var tr : ptree);
+begin
+  if tr <> nil then begin
+    DoWork(tr);
+    rootRL(tr^.right);
+    rootRL(tr^.left);
+   end;
+end;
+
+procedure RLroot(var tr : ptree);
+begin
+  if tr <> nil then begin
+    RLroot(tr^.right);
+    RLroot(tr^.left);
+    DoWork(tr);
+   end;
+end;
+
+function CreateDecTree(num : byte) : ptree;
+var ret : ptree;
+begin
+  if num = 0 then begin
+   CreateDecTree := nil;
+   exit;
+  end;
+  New(Ret);
+  Ret^.key := num;
+  Ret^.Left := CreateDecTree(num-1);
+  Ret^.Right := CreateDecTree(num-1);
+  CreateDecTree := ret;
+end; {CreateIncTree}
+
+function CreateIncTree(num,max : byte) : ptree;
+var ret : ptree;
+begin
+  if num = max+1 then begin
+   CreateIncTree := nil;
+   exit;
+  end;
+  New(Ret);
+  Ret^.key := num;
+  Ret^.Left := CreateIncTree(num+1,max);
+  Ret^.Right := CreateIncTree(num+1,max);
+  CreateIncTree := ret;
+end; {CreateIncTree}
+
+Function Search(sk : integer; var pt : ptree): boolean;
+begin
+  Search := false;
+  if pt^.key=sk then begin
+   search := true;
+   exit;
+  end;
+  if pt^.left <> nil then Search:=Search(sk,pt^.left);
+  if pt^.right <> nil then Search:=Search(sk,pt^.right);
+end;

PAS/!Other/S.PAS

@@ -0,0 +1,270 @@
+uses CRT;
+type
+        plist=^list;
+        list=record
+                b:real;
+                next:plist;
+        end;
+
+        plist3=^list3;
+        list3=record
+                b:char;
+                next:plist3;
+        end;
+
+{----------------------------------}
+function p1(l:plist; e:list):boolean;
+begin
+        if l=nil then
+                p1:=false
+        else
+                begin
+                 if l^.b = e.b then
+                         p1:=true
+                 else
+                         p1:=p1(l^.next, e);
+                end;
+end;{p1}
+{----------------------------------}
+procedure p2(l:plist;e:list;var num:byte);
+begin
+        if l<>nil then
+         begin
+                if l^.b=e.b then
+                 inc(num);
+                p2(l^.next,e,num);
+         end;
+end;{p2}
+{----------------------------------}
+function p11(l:plist):boolean;
+{var  num:byte; }
+begin
+ if l<>nil then
+  begin
+   if l^.b=l^.next ^.b then  p11:=true;
+   exit
+  end  
+   else
+     p11:=p11(l^.next) 
+  else
+     p11:=false
+ end;
+end;{p11}
+{----------------------------------}
+procedure p3(l:plist;var MAX:real);
+begin
+ if  l <>nil then
+        begin
+         if l^.b > max then max:=l^.b ;
+         p3(l^.next,max);
+        end;
+end;{p3}
+{----------------------------------}
+procedure p4(l:plist3);
+begin
+ if l<>nil then
+ begin
+         p4(l^.next);
+         write(l^.b);
+ end;
+end;{p4}
+{----------------------------------}
+procedure p5(l:plist;e1,e2:list);
+begin
+        if l<>nil then
+         begin
+                if l^.b=e1.b then
+                        l^.b:=e2.b;
+                p5(l^.next,e1,e2);
+         end;
+end;{p5}
+{----------------------------------}
+procedure p6(l:plist;e:list);
+var
+ lishniy:plist;
+begin
+if l^.next<>nil then
+ begin
+        if l^.next^.b=e.b then
+                begin
+                        lishniy:=l^.next;
+                        l^.next:=l^.next^.next;
+                        dispose(lishniy);
+                end
+        else
+                p6(l^.next,e)
+ end;
+end;{p6}
+{----------------------------------}
+procedure p7(l:plist;e:list);
+var
+ lishniy:plist;
+begin
+if l^.next<>nil then
+ begin
+        if l^.next^.b=e.b then
+                begin
+                        lishniy:=l^.next;
+                        l^.next:=l^.next^.next;
+                        dispose(lishniy);
+                end;
+        p7(l^.next,e)
+ end;
+end;{p7}
+{----------------------------------}
+function p8(l:plist):plist;
+var
+ n:plist;
+begin
+ if l <> nil then
+ begin
+        new(n);
+        n^.b:=l^.b;
+        n^.next := p8(l^.next);
+ end;
+ p8:=n;
+end;{p8}
+{----------------------------------}
+procedure p9(l:plist;e:list);
+var
+ n:plist;
+begin
+ if l<>nil then
+        begin
+         if l^.b=e.b then
+                begin
+                 new(n);
+                 n^.b:=e.b;
+                 n^.next:=l^.next;
+                 l^.next:=n;
+                 p9(l^.next^.next,e);
+                end
+         else
+                 p9(l^.next,e);
+        end;
+end;{p9}
+{----------------------------------}
+function p10(l:plist;sum:real;num:word):real;
+begin
+ if l<>nil then
+        p10:=p10(l^.next,sum+l^.b,num+1)
+ else
+        p10:=sum/(num-1);
+end;
+{----------------------------------}
+function NewList:plist;
+var
+ NN,p : plist;
+ i: byte;
+begin
+        nn:=nil;p:=nil;
+        for i := 1 to 10 do
+         begin
+                 New(p);
+                 Read(p^.b);
+                 P^.next:=nn;
+                 nn:=p;
+         end;
+        Newlist:=NN;
+end; {NewList}
+{--------------}
+function NewList2:plist3;
+var
+ NN,p : plist3;
+ i: byte;
+begin
+        nn:=nil;p:=nil;
+        for i := 1 to 10 do
+         begin
+                 New(p);
+                 Read(p^.b);
+                 P^.next:=nn;
+                 nn:=p;
+         end;
+        Newlist2:=NN;
+end; {NewList}
+{--------------}
+Procedure WriteList(L:plist);
+var p : plist;
+begin
+        p:=l;
+        while p <> nil do
+         begin
+                Write(p^.b:0:2,' ');
+                p:=p^.next;
+         end;
+end;{WriteList}
+
+
+var
+ l1,LL : plist;
+ l2 : plist3;
+ e,e2 : list;
+ k : byte;
+ m : real;
+begin
+        L1:=nil;ll:=nil;
+        WriteLN('‚¢¥¤¨â¥ 10 ç¨á¥«');
+        LL:=NewList;
+        Write('‚¢¥¤¨â¥ §­-¥ e');
+        Read(e.b);
+        if p1(LL,e) then
+         begin
+                 k:=0;
+                 p2(LL,e,k);
+                 WriteLn('� ©¤¥­®!, ',k,' à §');
+         end
+        else WriteLn('�¥ ­ ©¤¥­®!');
+        m := LL^.b;
+        {-------------------------------------}
+        p11(ll) ;
+        writeln(p11(ll))
+                                                                                                ;
+
+        p3(LL,m);
+        WriteLn('Œ ªá¨¬ã¬: ',m:0:2);
+        WriteLn('‚¢¥¤¨â¥ 10 ᨬ¢®«®¢ (¯® ®ç¥à¥¤¨!)');
+        l2:=NewlIst2;
+        Write('€ ⥯¥àì ®¡à â­®: ');
+        p4(l2);
+        writeln;
+        WriteLn('‘¯¨á®ª ¤®:');
+        WriteList(LL);
+        writeln;
+        WriteLn('‚¢¥¤¨â¥ çâ® ¨ ­  çâ® § ¬¥­ïâì:');
+
+
+        Read(e.b,e2.b);
+        p5(LL,e,e2);
+        WriteLn('‘¯¨á®ª ¯®á«¥ § ¬¥­ë:');
+        WriteList(LL);
+        writeln;
+
+        WriteLn('‚¢¥¤¨â¥ ç⮠㤠«ïâì:');
+        Read(e.b);
+        p6(LL,e);
+        WriteLn('‘¯¨á®ª ¯®á«¥ ®¤­®£® 㤠«¥­¨ï:');
+        WriteList(LL);
+        writeln;
+
+        WriteLn('‚¢¥¤¨â¥ ç⮠㤠«ïâì:');
+        Read(e.b);
+        p7(LL,e);
+        WriteLn('‘¯¨á®ª ¯®á«¥ ¢á¥å 㤠«¥­¨©:');
+        WriteList(LL);
+        writeln;
+
+        l1:=p8(LL);
+        WriteLn('€ ⥯¥àì L1');
+        WriteList(LL);
+        writeln;
+
+        WriteLn('‚¢¥¤¨â¥ ç⮠㤢 ¨¢ âì:');
+        Read(e.b);
+        p9(LL,e);
+        WriteLn('‘¯¨á®ª ¯®á«¥:');
+        WriteList(LL);
+        writeln;
+
+        WriteLn('‘।­.  à¨ä¬.: ',p10(LL,0,1):0:2);
+end.

PAS/!Other/oarrFunc.pas

@@ -0,0 +1,76 @@
+CONST
+  ArraySize = 7;
+
+type
+  ref = ^real;
+  vec = array [1..ArraySize] of ref;
+
+{------------------------------------}
+function MaxX(var X:vec):real;
+var
+ cm:real;
+ i:1..ArraySize;
+begin
+ cm :=-MaxInt;
+ for i:=1 to ArraySize do
+   if X[i]^ > cm then cm := X[i]^;
+ MaxX := cm;
+end; {MaxX}
+{--------------------------------}
+Function SameX(var X:vec):boolean;
+var
+  ret:boolean;
+  i,j:1..ArraySize;
+begin
+  ret:=false;
+  for i:=1 to ArraySize do
+    for j:=1 to ArraySize do
+      if (j <> i) and (X[i]=X[j]) then ret:=true;
+  SameX:=ret;
+end;{SameX}
+{--------------------------------}
+Procedure UniqueX(var X:vec);
+var
+  i,j:1..ArraySize;
+begin
+  for i:=1 to ArraySize do
+   for j:=1 to ArraySize do
+     if (I<>J) and (X[j]^=X[i]^) and (X[j]<>X[i]) then X[j]:=X[i];
+end;{UniqueX}
+{--------------------------------}
+Procedure ReadArray(var X:vec);
+var
+  i : 1..ArraySize;
+begin
+  for i := 1 to ArraySize do
+   begin
+     if X[i] = nil then New(X[I]);
+     Read(X[i]^);
+   end;
+end;{ReadArray}
+{--------------------------------}
+Procedure WriteArray(var X:vec);
+var
+  i : 1..ArraySize;
+begin
+  for i := 1 to ArraySize do
+     WriteLn(LongInt(X[i]),' --> ',X[i]^:4:3);
+end;{WriteArray}
+{---------------------------------}
+
+Var
+  X : vec;
+BEGIN
+  WriteLn('‚¢¥¤¨â¥ ',ArraySize, ' ç¨á¥«:');
+  ReadArray(X);
+  WriteLn('Œ ªá¨¬ «ì­®¥: ',MaxX(X):0:4);
+  WriteLn('Œ áᨢ, ¤® ¢ë¯®«­¥­¨ï ¯à®æ¥¤ãàë Unique');
+  WriteArray(X);
+  UniqueX(X);
+  WriteLn('Œ áᨢ, ¯®á«¥ ¢ë¯®«­¥­¨ï ¯à®æ¥¤ãàë Unique');
+  WriteArray(X);
+  if SameX(X) then
+   WriteLn('…áâì í«¥¬¥­âë á ®¤¨­ ª®¢ë¬¨ áá뫪 ¬¨')
+  else
+   WriteLn('�¥â í«¥¬¥­â®¢ á ®¤¨­ ª®¢ë¬¨ áá뫪 ¬¨');
+END.

PAS/!SPbSTU/10.PAS

@@ -0,0 +1,170 @@
+USES Graph;
+Type
+  PBTree = ^TBTree;
+  TBTree = record
+    info : string[30];
+    Left : PBTree;
+    Right: PBTree;
+  end;
+
+    ps  = ^el;
+    el  = record
+        data : integer;
+        prev : ps;
+    end;
+Var
+  inp : string;
+  p   : byte;
+  mh  : byte;
+
+{---------------------------------}
+Procedure DelBranch(br:PBTree);
+begin
+  if br^.left  <> nil then DelBranch(br^.left);
+  if br^.right <> nil then DelBranch(br^.right);
+  Dispose(br);
+end;{DelBranch}
+
+{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-}
+Function GetToken:string;
+var
+ ret : string[30];
+begin
+ ret :='';
+ while inp[p] = ' ' do inc(p);
+ while (not (inp[p] in [' ','(',')'])) and (p <= ord(inp[0])) do
+  begin
+   ret := ret+inp[p];
+   inc(p);
+  end;
+ While (inp[p] = ' ') and (p <= ord(inp[0])) do inc(p);
+ GetToken := ret;
+end;
+{--------------------}
+Procedure Create(TR:PBTree);
+var
+ aT : string[20];
+begin
+ tr^.left:=nil;
+ tr^.right:=nil;
+ while inp[p] = ' ' do inc(p);
+ 
+ if (copy(inp,p,3)<>'NOT') or 
+    (copy(inp,p,3)<>'not') then
+ begin
+  New(Tr^.left);
+  Tr^.left^.right:=nil;
+  Tr^.left^.left:=nil;
+  if inp[p] = '(' then 
+   begin 
+    inc(p);
+    Create(tr^.left);
+   end
+  else 
+   begin
+    aT:=GetToken;
+    if (aT<>'NOT') and (aT<>'AND') and (aT <> 'OR') and 
+       (aT<>'not') and (aT<>'and') and (aT <> 'or') then
+     tr^.left^.info := aT
+    else
+     begin
+      WriteLn('Get operation, when expected operand: ', aT);
+      Halt(255);
+     end;
+   end;
+ end;
+
+ tr^.info := GetToken;
+ if  (tr^.info <> 'AND') and (tr^.info <> 'and') and
+     (tr^.info <> 'NOT') and (tr^.info <> 'not') and
+     (tr^.info <> 'OR')  and (tr^.info <> 'or')  then
+    begin
+      WriteLn('Error at pos ',p - Length(tr^.info));
+      Halt(255);
+    end;
+    
+ new(tr^.right);
+ Tr^.right^.right:=nil;
+ Tr^.right^.left:=nil;
+ if (inp[p]='(') then 
+  begin 
+   inc(p);
+   Create(tr^.right) 
+  end
+ else 
+   begin
+    aT:=GetToken;
+    if aT = '' then
+     begin
+      WriteLn('No operand, when expected, pos ',p);
+      Halt(255);
+     end;
+    if ((aT<>'NOT') and (aT<>'AND') and (aT <> 'OR') and
+        (aT<>'not') and (aT<>'and') and (aT <> 'or')) then
+     tr^.right^.info := aT
+    else
+     begin
+      WriteLn('Get operation, when expected operand: ', aT);
+      Halt(255);
+     end;
+   end;
+
+ if (inp[p]=')') then inc(p);
+end;
+{---=--=--=-=-=-=-=-=---=-=-=-=-=--}
+Procedure DrawTree(aT:PBTree;x,y,h,dy:word);
+begin
+ if aT = nil then exit;
+ SetTextJustify(CenterText,BottomText);
+ OutTextXY(x,y,aT^.info);
+ if aT^.left <> nil then
+  begin
+    Line(x,y+1,x-(GetMaxX shr h),y+dy-1-TextHeight(at^.left^.info));
+    DrawTree(at^.left, x-(GetMaxX shr h),y+dy,h+1,dy);
+  end;
+ if aT^.right <> nil then
+  begin
+    Line(x,y+1,x+(GetMaxX shr h),y+dy-1-TextHeight(at^.right^.info));
+    DrawTree(at^.right,x+(GetMaxX shr h),y+dy,h+1,dy);
+  end;
+end;
+{=======================}
+Function Height(aT:PBTree;ch:byte):byte;
+begin
+if aT = nil then exit;
+ Height :=  Height(at^.left,ch+1);
+ Height :=  height(at^.right,ch+1);
+ if ch > mh then mh := ch;
+ Height := mh;
+end;
+{--------------}
+var
+  tree: PBTree;
+  grD,grM : integer;
+Begin
+  New(Tree);
+  Tree^.left:=nil;
+  Tree^.right:=nil;
+  p:=1;
+  mh:=0;
+ Assign(input,'10.txt');
+ {$I-}
+ Reset(input);
+ {$I+}
+ if IOResult <> 0 then
+ begin
+  WriteLN('File 10.txt not found!');
+  Halt(255);
+ end;
+  readln(inp);
+ Close(Input);
+ Assign(input,'CON');
+ Reset(input);
+  Create(tree);
+  grD:=Detect;
+InitGraph(grD,grM,'');
+  DrawTree(Tree,GetMaxX div 2,TextHeight(tree^.info)+20,2,(GetMaxY-20) div Height(Tree,1));
+  ReadLn;
+CloseGraph;           
+  DelBranch(tree);
+End.

PAS/!SPbSTU/10.txt

@@ -0,0 +1 @@
+Hello or (world AND (me OR (my AND I)))

PAS/!SPbSTU/1st/!

@@ -0,0 +1,50 @@
+隊�｢ｭ･ｭｨ･ 茴ｩｫｮ｢ OUT5.TXT ｨ OUT6.TXT
+****** OUT5.TXT
+Result:
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+権爼ｮ｢     159-99-80
+End.
+****** OUT6.TXT
+Result:
+蔵｢ｨｭｮ｢    930-05-57
+唱籵ｮ｢     598-13-12
+阿�ｭｮ｢     552-75-13
+ぇ皈ｫｮ｢�   543-60-21
+帳ｫ�ｫｮ｢    535-77-29
+€ｬ･ｫ�ｨｭ�  535-52-54
+則爼ｮ｢     535-50-16
+Πｫ罍･｢�   535-30-61
+┴ｮ､ｮ牋｢�  535-17-87
+樔･牋｢     533-95-89
+€ｪ皈ｭｮ｢    347-29-49
+あ皖ｫ�｢   341-64-38
+▼ｫｮ聶ｮ｢   341-06-19
+�ｨｪ･･｢    307-38-29
+�｡�爭｢    262-05-00
+刈鞳ｭ谿｢   233-77-04
+€ｫ･ｪ皈･｢   232-30-88
+権爼ｮ｢     159-99-80
+ぐｫｪｮ｢     113-90-25
+癌羆･ｭｪｮ   107-40-14
+End.
+******
+
+

PAS/!SPbSTU/1st/1.pas

@@ -0,0 +1,49 @@
+const
+ count		= 20;
+ len		= 20;
+ first_numb	= 12;
+var
+  DB	     : array [1..count,1..(len+2)] of char;
+  tmp        : array [1..(len+2)] of char;
+  INP	     : FILE of CHAR;
+  i,j,k,l    : integer;
+  ch	     : char;
+
+begin
+  Assign(INP,'phones.txt');
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+     begin
+       WriteLn('File ''phones.txt'' not found');
+       Halt(255);
+     end;
+  {$I+}
+
+  for i := 1 to count do
+   begin
+     for j := 1 to (len+2) do Read(INP,DB[i,j]);
+   end;
+  Close(INP);
+
+  for k := first_numb+8 downto first_numb do
+   if not (k in [first_numb+3,first_numb+6]) then
+    begin
+      for i := 1 to count-1 do
+       for j:=count-1 downto i do
+        begin
+          if DB[j+1,k] > DB[j,k] then
+           begin
+{Var 1}      Move(DB[j],tmp,len+2);
+             Move(DB[j+1],DB[j],len+2);
+             Move(tmp,DB[j+1],len+2);
+{Var 2       for l := 1 to len+2 do tmp[l]  := DB[j,l];
+             for l := 1 to len+2 do DB[j,l] := DB[j+1,l];
+             for l := 1 to len+2 do DB[j+1,l] := tmp[l]; }
+           end;
+        end;
+    end;
+  for i := 1 to count do
+   for j := 1 to len+2 do Write(DB[i,j]);
+  WriteLn('End.');
+end.

PAS/!SPbSTU/1st/2.pas

@@ -0,0 +1,53 @@
+const
+ count		= 20;
+ len		= 20;
+ first_numb	= 12;
+
+var
+  DB	     : array [1..count] of string;
+  INP	     : text;
+  k          : integer;
+
+Procedure Exchange(var s1,s2 : string);
+var
+ tmp : string;
+begin
+  tmp := s1;
+  s1 := s2;
+  s2 := tmp;
+end;
+
+Procedure SortNum(num : integer);
+var
+ i, j : integer;
+begin
+  for i := 1 to count-1 do
+   for j:=count-1 downto i do
+    begin
+     if DB[j+1,num] > DB[j,num] then Exchange(DB[j], DB[j+1]);
+    end;
+end;
+
+begin
+  Assign(INP,'phones.txt');
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+     begin
+       WriteLn('File ''phones.txt'' not found');
+       Halt(255);
+     end;
+  {$I+}
+
+  for k := 1 to count do
+     ReadLn(INP,DB[k]);
+  Close(INP);
+
+  for k := first_numb+8 downto first_numb do
+   if not (k in [first_numb+3,first_numb+6]) then
+     SortNum(k);
+
+  for k := 1 to count do
+    WriteLn(DB[k]);
+  WriteLn('End.');
+end.

PAS/!SPbSTU/1st/3.pas

@@ -0,0 +1,68 @@
+const
+ count		= 20;
+ name_len       = 11;
+ phone_len      = 9;
+ separators     = [4,7];
+
+type TPhoneEntry = record
+  Name  : string[name_len];
+  Phone : string[phone_len];
+end;
+
+var
+  DB	     : array [1..count] of TPhoneEntry;
+  INP	     : file of TPhoneEntry;
+  k,i        : integer;
+
+Procedure Exchange(var s1,s2 : TPhoneEntry);
+var
+ tmp : TPhoneEntry;
+begin
+  tmp := s1;
+  s1 := s2;
+  s2 := tmp;
+end;
+
+Procedure SortNum(num : integer);
+var
+ i, j : integer;
+begin
+  for i := 1 to count-1 do
+   for j:=count-1 downto i do
+    begin
+     if DB[j+1].Phone[num] > DB[j].Phone[num] then Exchange(DB[j], DB[j+1]);
+    end;
+end;
+
+begin
+  Assign(INP,'phones.dat');
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+     begin
+       WriteLn('File ''phones.dat'' not found');
+       Halt(255);
+     end;
+  {$I+}
+
+  k:=1;
+  while not eof(inp) do
+   begin
+     Read(INP,DB[k]);
+     inc(k);
+   end;
+
+  Close(INP);
+
+  for k := phone_len downto 1 do
+   if not (k in Separators) then
+     SortNum(k);
+
+  for k := 1 to count do
+   begin
+    Write(DB[k].Name);
+    for i:=1 to 11-Length(DB[k].Name) do Write(' ');
+    WriteLn(DB[k].Phone);
+   end;
+  WriteLn('End.');
+end.

PAS/!SPbSTU/1st/4.PAS

@@ -0,0 +1,34 @@
+uses for4;
+const
+ count		= 20;
+ len		= 20;
+ first_numb	= 12;
+
+var
+  DB	     : array [0..count-1] of string;
+  INP	     : text;
+  k          : integer;
+
+
+begin
+  Assign(INP,'phones.txt');
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+     begin
+       WriteLn('File ''phones.txt'' not found');
+       Halt(255);
+     end;
+  {$I+}
+
+  for k := 0 to count-1 do ReadLn(INP,DB[k]);
+  Close(INP);
+
+  for k := first_numb+8 downto first_numb do
+   if not (k in [first_numb+3,first_numb+6]) then
+     SortNum(DB,k,count);
+
+  for k := 0 to count-1 do
+    WriteLn(DB[k]);
+  WriteLn('End.');
+end.

PAS/!SPbSTU/1st/5.BAK

@@ -0,0 +1,118 @@
+const
+ name_len       = 11;
+ phone_len      = 9;
+ separators     = [4,7];
+type
+ PPhoneEntry = ^TPhoneEntry;
+
+ TPhoneEntry = record
+   Name  : string[name_len];
+   Phone : string[phone_len];
+   Next  : PPhoneEntry;
+ end;
+{----------------------------------------}
+Procedure AddEntry(var CPEntry : PPhoneEntry;aName,aPhone : string);
+var
+ NE : PPhoneEntry;
+ num : string;
+ i  : integer;
+begin
+ New(NE);
+ with NE^ do
+  begin
+    Name := aName;
+    Phone := aPhone;
+    Next := CPEntry;
+  end;
+ CPEntry := NE;
+end;{AddEntry}
+{----------------------------------------}
+Procedure SortNum(var L:PPhoneEntry);
+var
+ c,t,m  : PPhoneEntry;
+begin
+ if L^.Next = nil then exit;
+ C:=L^.next;
+ M:=L;
+ while (C^.Next <> nil) do
+  begin
+   if C^.Next^.Phone > M^.Next^.Phone then M:=C;
+   C:=C^.Next;
+  end;
+ if M^.Next^.Phone > L^.Phone then
+  begin
+    T:=M^.Next;
+    M^.Next:=T^.Next;
+    T^.Next:=L;
+    L:=T;
+  end;
+ M:=L;
+ while M^.Next^.Next <> nil do
+  begin
+    c:=M^.Next;
+    while C^.Next <> nil do
+     begin
+      if C^.Next^.Phone > M^.Next^.Phone then
+       begin
+        T:=C^.NEXT;
+        C^.NEXT:=T^.NEXT;
+        T^.NEXT:=M^.NEXT;
+        M^.NEXT:=T;
+       end
+      else
+       C:=C^.Next;
+     end;
+     M:=M^.Next;
+  end;
+end;{SortNum}
+{----------------------------------------}
+var
+  DB,c	     : PPhoneEntry;
+  INP	     : text;
+  Name       : string[Name_Len];
+  Phone      : string[Phone_Len];
+  i        : integer;
+
+
+begin
+  Assign(INP,'phones.txt');
+  Assign(Output,'out5.txt');
+  Rewrite(Output);
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+     begin
+       WriteLn('File ''phones.txt'' not found');
+       Halt(255);
+     end;
+  {$I+}
+
+  DB:=nil;
+
+  While not EOF(INP) do
+   begin
+     Read(INP,Name);
+     ReadLn(INP,Phone);
+     AddEntry(DB,Name,Phone);
+     WriteLn(Name,Phone);
+   end;
+  Close(INP);
+  WriteLn('Result:');
+
+  SortNum(DB);
+
+  c:=DB;
+  while C<>nil do
+   begin
+    WriteLn(C^.Name,C^.Phone);
+    C:=C^.Next;
+   end;
+  WriteLn('End.');
+
+  while DB<>nil do
+   begin
+     C:=DB^.Next;
+     Dispose(DB);
+     DB:=C;
+   end;
+end.

PAS/!SPbSTU/1st/5.PAS

@@ -0,0 +1,118 @@
+const
+ name_len       = 11;
+ phone_len      = 9;
+ separators     = [4,7];
+type
+ PPhoneEntry = ^TPhoneEntry;
+
+ TPhoneEntry = record
+   Name  : string[name_len];
+   Phone : string[phone_len];
+   Next  : PPhoneEntry;
+ end;
+{----------------------------------------}
+Procedure AddEntry(var CPEntry : PPhoneEntry;aName,aPhone : string);
+var
+ NE : PPhoneEntry;
+ num : string;
+ i  : integer;
+begin
+ New(NE);
+ with NE^ do
+  begin
+    Name := aName;
+    Phone := aPhone;
+    Next := CPEntry;
+  end;
+ CPEntry := NE;
+end;{AddEntry}
+{----------------------------------------}
+Procedure SortNum(var L:PPhoneEntry);
+var
+ c,t,m  : PPhoneEntry;
+begin
+ if L^.Next = nil then exit;
+ C:=L^.next;
+ M:=L;
+ while (C^.Next <> nil) do
+  begin
+   if C^.Next^.Phone > M^.Next^.Phone then M:=C;
+   C:=C^.Next;
+  end;
+ if M^.Next^.Phone > L^.Phone then
+  begin
+    T:=M^.Next;
+    M^.Next:=T^.Next;
+    T^.Next:=L;
+    L:=T;
+  end;
+ M:=L;
+ while M^.Next^.Next <> nil do
+  begin
+    c:=M^.Next;
+    while C^.Next <> nil do
+     begin
+      if C^.Next^.Phone > M^.Next^.Phone then
+       begin
+        T:=C^.NEXT;
+        C^.NEXT:=T^.NEXT;
+        T^.NEXT:=M^.NEXT;
+        M^.NEXT:=T;
+       end
+      else
+       C:=C^.Next;
+     end;
+     M:=M^.Next;
+  end;
+end;{SortNum}
+{----------------------------------------}
+var
+  DB,c	     : PPhoneEntry;
+  INP	     : text;
+  Name       : string[Name_Len];
+  Phone      : string[Phone_Len];
+  i        : integer;
+
+
+begin
+  Assign(INP,'phones.txt');
+  Assign(Output,'out5.txt');
+  Rewrite(Output);
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+     begin
+       WriteLn('File ''phones.txt'' not found');
+       Halt(255);
+     end;
+  {$I+}
+
+  DB:=nil;
+
+  While not EOF(INP) do
+   begin
+     Read(INP,Name);
+     ReadLn(INP,Phone);
+     AddEntry(DB,Name,Phone);
+     WriteLn(Name,Phone);
+   end;
+  Close(INP);
+  WriteLn('Result:');
+
+  SortNum(DB);
+
+  c:=DB;
+  while C<>nil do
+   begin
+    WriteLn(C^.Name,C^.Phone);
+    C:=C^.Next;
+   end;
+  WriteLn('End.');
+
+  while DB<>nil do
+   begin
+     C:=DB^.Next;
+     Dispose(DB);
+     DB:=C;
+   end;
+end.

PAS/!SPbSTU/1st/6.BAK

@@ -0,0 +1,80 @@
+const
+ name_len       = 11;
+ phone_len      = 9;
+type
+ TPE = record
+   Name  : string[name_len];
+   Phone : string[phone_len];
+ end;
+ TPEa = array [1..20] of TPE;
+
+Procedure Exchange(var a,b:TPE);
+var
+ t:tpe;
+begin
+ t:=a;a:=b;b:=t;
+end;{Exchange}
+{----------------------------------------}
+Procedure QSort(var aA:TPEa;L,R:word);
+var
+ i,j : word;
+ cen : string[phone_len];
+begin
+  if L<>R then
+   begin
+     cen:=aA[(l+r) div 2].Phone;
+     i:=l;
+     j:=r;
+     while i<=j do
+     begin
+       while (i<r) and (aa[i].Phone > cen) do inc(i);
+       while (j>l) and (aa[j].Phone < cen) do dec(j);
+       if i<j then
+       begin
+        Exchange(aA[i],aA[j]);
+        Inc(i);
+        Dec(j);
+       end;
+     end;
+     if j > L then QSort(Aa,L,j);
+     if i < r then QSort(aA,i,r);
+   end;
+end;{SortNum}
+{----------------------------------------}
+var
+  Ar         : TPEa;
+  INP	     : text;
+  i,cnt      : integer;
+
+
+begin
+  Assign(INP,'phones.txt');
+  Assign(Output,'out6.txt');
+  Rewrite(Output);
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+     begin
+       WriteLn('File ''phones.txt'' not found');
+       Halt(255);
+     end;
+  {$I+}
+
+  cnt:=1;
+  While not EOF(INP) do
+   begin
+     Read(INP,Ar[cnt].Name);
+     ReadLn(INP,Ar[cnt].Phone);
+     WriteLn(Ar[cnt].Name,Ar[cnt].Phone);
+     inc(cnt);
+   end;
+  Close(INP);
+  WriteLn('Result:');
+  Dec(cnt);
+
+  QSort(Ar,1,cnt);
+
+  for i := 1 to cnt do WriteLn(Ar[i].Name,Ar[i].Phone);
+  WriteLn('End.');
+
+end.

PAS/!SPbSTU/1st/6.PAS

@@ -0,0 +1,80 @@
+const
+ name_len       = 11;
+ phone_len      = 9;
+type
+ TPE = record
+   Name  : string[name_len];
+   Phone : string[phone_len];
+ end;
+ TPEa = array [1..20] of TPE;
+
+Procedure Exchange(var a,b:TPE);
+var
+ t:tpe;
+begin
+ t:=a;a:=b;b:=t;
+end;{Exchange}
+{----------------------------------------}
+Procedure QSort(var aA:TPEa;L,R:word);
+var
+ i,j : word;
+ cen : string[phone_len];
+begin
+  if L<>R then
+   begin
+     cen:=aA[(l+r) div 2].Phone;
+     i:=l;
+     j:=r;
+     while i<=j do
+     begin
+       while (i<r) and (aa[i].Phone > cen) do inc(i);
+       while (j>l) and (aa[j].Phone < cen) do dec(j);
+       if i<=j then
+       begin
+        Exchange(aA[i],aA[j]);
+        Inc(i);
+        Dec(j);
+       end;
+     end;
+     if j > L then QSort(Aa,L,j);
+     if i < r then QSort(aA,i,r);
+   end;
+end;{SortNum}
+{----------------------------------------}
+var
+  Ar         : TPEa;
+  INP	     : text;
+  i,cnt      : integer;
+
+
+begin
+  Assign(INP,'phones.txt');
+  Assign(Output,'out6.txt');
+  Rewrite(Output);
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+     begin
+       WriteLn('File ''phones.txt'' not found');
+       Halt(255);
+     end;
+  {$I+}
+
+  cnt:=1;
+  While not EOF(INP) do
+   begin
+     Read(INP,Ar[cnt].Name);
+     ReadLn(INP,Ar[cnt].Phone);
+     WriteLn(Ar[cnt].Name,Ar[cnt].Phone);
+     inc(cnt);
+   end;
+  Close(INP);
+  WriteLn('Result:');
+  Dec(cnt);
+
+  QSort(Ar,1,cnt);
+
+  for i := 1 to cnt do WriteLn(Ar[i].Name,Ar[i].Phone);
+  WriteLn('End.');
+
+end.

PAS/!SPbSTU/1st/CONV.BAK

@@ -0,0 +1,41 @@
+const
+ count		= 20;
+ name_len       = 11;
+ phone_len      = 9;
+
+type TPhoneEntry = record
+  Name  : string[name_len];
+  Phone : string[phone_len];
+end;
+
+
+var
+  DB2	     : array [1..count] of TPhoneEntry;
+  INP	     : text;
+  Output     : FILE oF TPhoneEntry;
+  k          : integer;
+
+begin
+  Assign(INP,'phones.txt');
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+     begin
+       WriteLn('File ''phones.txt'' not found');
+       Halt(255);
+     end;
+  {$I+}
+
+  for k := 1 to count do
+   begin
+     Read(INP,DB2[k].Name);
+     ReadLn(DB2[k].Phone);
+   end;
+
+  Close(INP);
+
+  Assign(Output,'phones.dat');
+  Rewrite(Output);
+  for k:=1 to count do Write(Output,DB2[k]);
+  Close(Output);
+end.

PAS/!SPbSTU/1st/FOR4.PAS

@@ -0,0 +1,26 @@
+unit for4;
+interface
+  procedure Exchange(var s1,s2 : string);
+  Procedure SortNum(var DB:array of string;num,count : integer);
+implementation
+
+Procedure Exchange(var s1,s2 : string);
+var
+ tmp : string;
+begin
+  tmp := s1;
+  s1 := s2;
+  s2 := tmp;
+end;
+
+Procedure SortNum(var DB:array of string;num,count : integer);
+var
+ i, j : integer;
+begin
+  for i := 0 to count-2 do
+   for j:=count-2 downto i do
+    begin
+     if DB[j+1,num] > DB[j,num] then Exchange(DB[j], DB[j+1]);
+    end;
+end;
+end.

PAS/!SPbSTU/1st/OUT5.TXT

@@ -0,0 +1,42 @@
+�¥â஢     598-13-12
+ˆ¢ ­®¢     552-75-13
+ƒ®«ã¡¥¢    535-30-61
+‘¥àª®¢     535-50-16
+žä¥à®¢     533-95-89
+‡ã¡ à¥¢    262-05-00
+…­¨ª¥¥¢    307-38-29
+’ « «®¢    535-77-29
+‚ á¨«ì¥¢   341-64-38
+€ªá¥­®¢    347-29-49
+€¬¥«ìª¨­   535-52-54
+„¨®¤®à®¢   535-17-87
+‘ ¢¨­®¢    930-05-57
+€«¥ªá¥¥¢   232-30-88
+�¥«®ãᮢ   341-06-19
+‚¥á¥«®¢    543-60-21
+‚®«ª®¢     113-90-25
+Š èã­æ®¢   233-77-04
+Šà㯥­ª®   107-40-14
+Œ àª®¢     159-99-80
+Result:
+‘ ¢¨­®¢    930-05-57
+�¥â஢     598-13-12
+ˆ¢ ­®¢     552-75-13
+‚¥á¥«®¢    543-60-21
+’ « «®¢    535-77-29
+€¬¥«ìª¨­   535-52-54
+‘¥àª®¢     535-50-16
+ƒ®«ã¡¥¢    535-30-61
+„¨®¤®à®¢   535-17-87
+žä¥à®¢     533-95-89
+€ªá¥­®¢    347-29-49
+‚ á¨«ì¥¢   341-64-38
+�¥«®ãᮢ   341-06-19
+…­¨ª¥¥¢    307-38-29
+‡ã¡ à¥¢    262-05-00
+Š èã­æ®¢   233-77-04
+€«¥ªá¥¥¢   232-30-88
+Œ àª®¢     159-99-80
+‚®«ª®¢     113-90-25
+Šà㯥­ª®   107-40-14
+End.

PAS/!SPbSTU/1st/OUT6.TXT

@@ -0,0 +1,42 @@
+�¥â஢     598-13-12
+ˆ¢ ­®¢     552-75-13
+ƒ®«ã¡¥¢    535-30-61
+‘¥àª®¢     535-50-16
+žä¥à®¢     533-95-89
+‡ã¡ à¥¢    262-05-00
+…­¨ª¥¥¢    307-38-29
+’ « «®¢    535-77-29
+‚ á¨«ì¥¢   341-64-38
+€ªá¥­®¢    347-29-49
+€¬¥«ìª¨­   535-52-54
+„¨®¤®à®¢   535-17-87
+‘ ¢¨­®¢    930-05-57
+€«¥ªá¥¥¢   232-30-88
+�¥«®ãᮢ   341-06-19
+‚¥á¥«®¢    543-60-21
+‚®«ª®¢     113-90-25
+Š èã­æ®¢   233-77-04
+Šà㯥­ª®   107-40-14
+Œ àª®¢     159-99-80
+Result:
+‘ ¢¨­®¢    930-05-57
+�¥â஢     598-13-12
+ˆ¢ ­®¢     552-75-13
+‚¥á¥«®¢    543-60-21
+’ « «®¢    535-77-29
+€¬¥«ìª¨­   535-52-54
+‘¥àª®¢     535-50-16
+ƒ®«ã¡¥¢    535-30-61
+„¨®¤®à®¢   535-17-87
+žä¥à®¢     533-95-89
+€ªá¥­®¢    347-29-49
+‚ á¨«ì¥¢   341-64-38
+�¥«®ãᮢ   341-06-19
+…­¨ª¥¥¢    307-38-29
+‡ã¡ à¥¢    262-05-00
+Š èã­æ®¢   233-77-04
+€«¥ªá¥¥¢   232-30-88
+Œ àª®¢     159-99-80
+‚®«ª®¢     113-90-25
+Šà㯥­ª®   107-40-14
+End.

PAS/!SPbSTU/1st/conv.pas

@@ -0,0 +1,41 @@
+const
+ count		= 20;
+ name_len       = 11;
+ phone_len      = 9;
+
+type TPhoneEntry = record
+  Name  : string[name_len];
+  Phone : string[phone_len];
+end;
+
+
+var
+  DB2	     : array [1..count] of TPhoneEntry;
+  INP	     : text;
+  Output     : FILE oF TPhoneEntry;
+  k          : integer;
+
+begin
+  Assign(INP,'phones.txt');
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+     begin
+       WriteLn('File ''phones.txt'' not found');
+       Halt(255);
+     end;
+  {$I+}
+
+  for k := 1 to count do
+   begin
+     Read(INP,DB2[k].Name);
+     ReadLn(INP,DB2[k].Phone);
+   end;
+
+  Close(INP);
+
+  Assign(Output,'phones.dat');
+  Rewrite(Output);
+  for k:=1 to count do Write(Output,DB2[k]);
+  Close(Output);
+end.

PAS/!SPbSTU/1st/phones.DAT

@@ -0,0 +1 @@
+�¥â஢     	598-13-12ˆ¢ ­®¢     	552-75-13ƒ®«ã¡¥¢    	535-30-61‘¥àª®¢     	535-50-16žä¥à®¢     	533-95-89‡ã¡ à¥¢    	262-05-00…­¨ª¥¥¢    	307-38-29’ « «®¢    	535-77-29‚ á¨«ì¥¢   	341-64-38€ªá¥­®¢    	347-29-49€¬¥«ìª¨­   	535-52-54„¨®¤®à®¢   	535-17-87‘ ¢¨­®¢    	930-05-57€«¥ªá¥¥¢   	232-30-88�¥«®ãᮢ   	341-06-19‚¥á¥«®¢    	543-60-21‚®«ª®¢     	113-90-25Š èã­æ®¢   	233-77-04Šà㯥­ª®   	107-40-14Œ àª®¢     	159-99-80

PAS/!SPbSTU/1st/phones.txt

@@ -0,0 +1,20 @@
+�¥â஢     598-13-12
+ˆ¢ ­®¢     552-75-13
+ƒ®«ã¡¥¢    535-30-61
+‘¥àª®¢     535-50-16
+žä¥à®¢     533-95-89
+‡ã¡ à¥¢    262-05-00
+…­¨ª¥¥¢    307-38-29
+’ « «®¢    535-77-29
+‚ á¨«ì¥¢   341-64-38
+€ªá¥­®¢    347-29-49
+€¬¥«ìª¨­   535-52-54
+„¨®¤®à®¢   535-17-87
+‘ ¢¨­®¢    930-05-57
+€«¥ªá¥¥¢   232-30-88
+�¥«®ãᮢ   341-06-19
+‚¥á¥«®¢    543-60-21
+‚®«ª®¢     113-90-25
+Š èã­æ®¢   233-77-04
+Šà㯥­ª®   107-40-14
+Œ àª®¢     159-99-80

PAS/!SPbSTU/2nd/2.PAS

@@ -0,0 +1,89 @@
+const
+  InName  = '2.txt';
+  OutName = '2.out';
+type
+  plist = ^tlist;
+  tlist = record
+    s:string;
+    next:plist;
+  end;
+
+var
+  strings,cs,ls : plist;
+  tocopy,cc,lc  : plist;
+  INP,OUTP      : text;
+  counter       : word;
+  NB,KB,M       : word;
+begin
+  Assign(INP,InName);
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+    begin
+      WriteLn('Žè¨¡ª  ®âªàëâ¨ï ä ©«  ''',InName,''', ª®¤: ', IOResult);
+      Halt(200);
+    end;
+  Assign(OUTP,OutName);
+  Rewrite(OUTP);
+    If IOResult <> 0 then
+    begin
+      WriteLn('Žè¨¡ª  ®âªàëâ¨ï ä ©«  ¤«ï ç⥭¨ï ''',OutName,''', ª®¤: ', IOResult);
+      Halt(201);
+    end;
+  {$I+}
+
+  Write('‚¢¥¤¨â¥ ­®¬¥à ¯¥à¢®© áâப¨ á ª®â®à®© ª®¯¨à®¢ âì: ');
+  ReadLn(NB);
+  Write('‚¢¥¤¨â¥ ­®¬¥à ¯®á«¥¤­¥© áâப¨ ¤® ª®â®à®© ª®¯¨à®¢ âì: ');
+  ReadLn(KB);
+  Write('‚¢¥¤¨â¥ ­®¬¥à áâப¨ ¯¥à¥¤ ª®â®à®© ¢áâ ¢¨âì: ');
+  ReadLn(M);
+
+  counter:=1;
+  New(cs);
+  New(cc);
+  strings := cs;
+  tocopy := cc;
+  while not EOF(INP) do
+  begin
+    ReadLn(INP,cs^.s);
+    New(cs^.next);
+    if counter in [NB..KB] then
+     begin
+       cc^.s := cs^.s;
+       lc := cc;
+       New(cc^.next);
+       cc:=cc^.next;
+     end;
+    ls:=cs;
+    cs:=cs^.next;
+    inc(counter);
+  end;
+  Dispose(cc);Dispose(cs);
+  lc^.next:=nil;
+  ls^.next:=nil;
+  Close(INP);
+
+  counter := 1;
+  cs:=strings;
+  cc:=tocopy;
+  while cs<>nil do
+  begin
+    if counter = M then
+      while cc<>nil do
+      begin
+        WriteLn(OUTP,cc^.s);
+        cc:=cc^.next;
+      end;
+    WriteLn(OUTP,cs^.s);
+    cs:=cs^.next;
+    inc(counter);
+  end;
+  if counter = M then
+    while cc<>nil do
+    begin
+      WriteLn(OUTP,cc^.s);
+      cc:=cc^.next;
+    end;
+  Close(OUTP);
+end.

PAS/!SPbSTU/2nd/2.txt

@@ -0,0 +1,21 @@
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+11
+12
+13
+14
+15
+16
+17
+18
+19
+20
+21

PAS/!SPbSTU/2nd/3.OUT

@@ -0,0 +1,2 @@
+22.333.4444.1.55555.333.4444.Result:
+55555.4444.4444.333.333.22.1.

PAS/!SPbSTU/2nd/3.PAS

@@ -0,0 +1,148 @@
+const
+  InName  = '3.txt';
+  OutName = '3.out';
+type
+  plist = ^tlist;
+  tlist = record
+    s:string;
+    next,prev:plist;
+  end;
+{----------------------------}
+Function InsertBefore(aW,aB : plist):boolean;
+var
+  BP,WN:plist;
+begin
+  if aW = aB then begin InsertBefore := false; exit; end;
+  InsertBefore := true;
+  bp := aB^.prev; WN:=aW^.next;
+
+  if aW^.prev <> nil then aW^.Prev^.Next := WN;
+  if WN <> NIL       then WN^.Prev := aW^.prev;
+
+  aW^.Prev := BP;
+  if BP <> nil then BP^.Next := aW;
+
+  aB^.Prev := aW;
+  aW^.Next := aB;
+end;{InsertBefore}
+{----------------------------}
+Function FindMed(a1,a2 : plist):plist;
+var
+ count,i : word;
+ ca      : plist;
+begin
+  if a1 = a2 then begin FindMed := a1;exit;end;
+  ca := a1;
+  count := 0;
+  while (ca<>nil) and (ca<>a2) do
+  begin
+    inc(count);
+    ca:=ca^.next;
+  end;
+  if ca = a2 then
+   begin
+     for i := 1 to count div 2 do ca:=ca^.prev;
+     FindMed := ca;exit;
+   end
+  else
+   begin
+    ca := a1;
+    count := 0;
+    while (ca<>nil) and (ca<>a2) do
+    begin
+      inc(count);
+      ca:=ca^.prev;
+    end;
+    if ca = a2 then
+     begin
+       for i := 1 to count div 2 do ca:=ca^.next;
+       FindMed := ca;exit;
+     end
+    else FindMed:=a1;
+   end;
+end;{FindMed}
+{----------------------------}
+Function FindPlace(aB,aE,aV:plist):plist;
+var
+ med : plist;
+begin
+  if ord(aE^.s[0]) > ord(aV^.s[0]) then begin FindPlace:=aV;exit;end;
+  while (aB^.Next <> aE) and (aB <> aE) do
+  begin
+    med := FindMed(aB,aE);
+    if ord(med^.s[0]) > ord(aV^.s[0]) then aB:=med
+    else aE := med;
+  end;
+  if ord(aB^.s[0]) < ord(aV^.s[0]) then FindPlace := aB else FindPlace := aE;
+end;{FindPlace}
+{----------------------------}
+Procedure Sort(var aL : plist);
+var
+  i : plist;
+begin
+  i:=aL;
+  while i^.next <> nil do
+  begin
+    if not InsertBefore(i^.next,Findplace(aL,i,i^.next)) then i:=i^.next;
+    while aL^.Prev <> nil do aL:=aL^.prev;
+  end;
+end;{Sort}
+{----------------------------}
+var
+  strings,cs,ls : plist;
+  INP,OUTP      : text;
+  ch            : char;
+begin
+  Assign(INP,InName);
+  {$I-}
+    Reset(INP);
+    If IOResult <> 0 then
+    begin
+      WriteLn('Žè¨¡ª  ®âªàëâ¨ï ä ©«  ''',InName,''', ª®¤: ', IOResult);
+      Halt(200);
+    end;
+  Assign(OUTP,OutName);
+  Rewrite(OUTP);
+    If IOResult <> 0 then
+    begin
+      WriteLn('Žè¨¡ª  ®âªàëâ¨ï ä ©«  ¤«ï ç⥭¨ï ''',OutName,''', ª®¤: ', IOResult);
+      Halt(201);
+    end;
+  {$I+}
+
+  New(cs);
+  cs^.prev:=nil;
+  strings := cs;
+  while not EOF(INP) do
+  begin
+    ch:=#0;
+    cs^.s:='';
+    while (ch <> '.') and Not EOF(INP) do
+    begin
+     Read(inp,ch);
+     cs^.s := cs^.s + ch;
+    end;
+    New(cs^.next);
+    ls:=cs;
+    cs:=cs^.next;
+    cs^.prev := ls;
+  end;
+  Dispose(cs);
+  ls^.next:=nil;
+  Close(INP);
+  cs:=strings;
+  while cs<>nil do
+  begin
+    Write(OUTP,cs^.s);
+    cs:=cs^.next;
+  end;
+  WriteLn(OUTP,'Result:');
+  Sort(strings);
+  cs:=strings;
+  while cs<>nil do
+  begin
+    Write(OUTP,cs^.s);
+    cs:=cs^.next;
+  end;
+  Close(OUTP);
+end.

PAS/!SPbSTU/2nd/3.TXT

@@ -0,0 +1 @@
+22.333.4444.1.55555.333.4444.

PAS/!SPbSTU/2nd/4TH.PAS

@@ -0,0 +1,143 @@
+{�ணࠬ¬  ¤«ï ç⥭¨ï ¨§ ä ©«  áâப ¨ ®¤­®¢à¥¬¬¥­­®¥ ᮧ¤ ­¨¥ «¨­¥©­®£®
+âਭ ¯à ¢«¥­­®£® ᯨ᪠, 1-© - ª ª ¢ ä ©«¥, 2-© ®âá®àâ. ¯® ã¡ë¢, 3-© - ¯® ¢®§à.}
+{Copyright Innocenty Enikeew (YEAR-2000)084/1 17.10.2001}
+type
+ PList = ^TList;
+ chains   = array[1..3] of PList; {Œ áᨢ 㪠§ â¥«¥© ­  í«-âë}
+ TList = record
+   s : string;  {‡­ ç¥­¨¥ í«-â  á¯¨áª .}
+   next : chains; {Œ áᨢ ááë«®ª. 1-© - ­  á«¥¤ãî騩
+                                  2-© - ­  á®àâ¨à®¢ ­­ë© ¯® ã¡ë¢
+                                  3-© - --------\\--------- ¢®§à®áâ}
+ end;
+Const
+ msgs : array [1..3] of string = ('­¥ ®âá®àâ¨à®¢ ­­ë©','®âá®àâ¨à®¢ ­­ë© ¯® ã¡ë¢ ­¨î','®âá®àâ¨à®¢ ­­ë© ¯® ¢®§à®áâ ­¨î');
+  {Œ áᨢ á®®¡é¥­¨© ® á®àâ¨à®¢ª¥}
+{--------------------------------------------------------}
+Procedure CreateList(var F:text;var hs,ts : chains);
+{�à®æ¥¤ãà  ç⥭¨ï í«¥¬¥­â®¢ ¨§ ä ©«  á ®¤­®¢à¥¬¥­­®© á®àâ¨à®¢ª®© ¯® ã¡ë¢ ­¨î
+ ¨ ¢®§à®áâ ­¨î
+ ‚室­ë¥:
+  F  - ⥪áâ®¢ë© ä ©«, ®âªã¤  áç¨â¨¢ îâáï ¤ ­­ë¥
+ ‚ë室­ë¥
+  hs - ¬ áᨢ 㪠§ â¥«¥© ­  £®«®¢ë ᯨ᪮¢
+  ts - ---------//--------- 墮áâë ᯨ᪮¢
+€«£®à¨â¬ à ¡®âë:
+ 1) ‘ç¨â뢠¥âáï ¯¥à¢ë© í«¥¬¥­â, ª®â®àë¬ ¨­¨æ¨ «¨§¨àãîâáï ‚‘… 㪠§ â¥«¨
+ 2) �®ª  ä ©« ­¥ ª®­ç¨âáï, ᮧ¤ ¥¬ ¨ áç¨â뢠¥¬ á«¥¤ãî騩 í«¥¬¥­â. ‡ ¯¨á뢠¥¬ 
+    ¢ 1-© 㪠§ â¥«ì
+ 3) � å®¤¨¬ ¬¥áâ® ¯® ¢®§à áâ ­¨î. ‚áâ ¢«ï¥¬ â㤠, ¯®«ãç ï 2-î áá뫪ã
+ 4) ------\\-------- ã¡ë¢ ­¨î.    ----------\\-----------  3-î
+ 5) �¥à¥å®¤ ­¥ 2
+}
+var
+ i           : integer;  {“ª §ë¢ ¥â ­®¬¥à áá뫪¨}
+ n,c         : PList;    {á - ­®¢ë© ᮧ¤ ­­ë©, n - "¡¥£ã­®ª" ¤«ï ¯®¨áª  ¬¥áâ }
+begin                           
+  New(Hs[1]);                { \ }
+  Hs[2]:=Hs[1];              { | }
+  Hs[3]:=Hs[1];              { | }
+  for i := 1 to 3 do         { | ‘®§¤ ­¨¥ }
+   begin                     { | ¨ ç⥭¨¥ �…�‚ŽƒŽ í«¥¬¥­â }
+    ts[i]:=hs[1];            { | }
+    Hs[1]^.next[i] := nil;   { | }
+   end;                      { | }
+  ReadLn(F,Hs[1]^.s);        { / }
+  while not EOF(F) do       {Žá­®¢­®© 横« áç¨â뢠­¨ï í«¥¬¥­â®¢}
+  begin
+    New(c);for i := 1 to 3 do c^.next[i]:=nil;  {‚뤥«¥­¨¥ ­®¢®£® í«-â  ¨
+                                                 ¨­¨æ¨ «¨§ æ¨ï ¥£® ááë«®ª}
+    ts[1]^.Next[1] := c;     {‡ ­¥á¥¬ ¥£® ¢ ª®­¥æ ¯¥à¢®© 楯®çª¨}
+    ts[1]:=c;                {¨ ᤢ¨­¥¬ ¥¥ 墮áâ}
+    ReadLn(c^.s);
+    for i := 2 to 3 do
+    {„ ­­ë© 横« ®¡ê¥¤¨­ï¥â ¢ ᥡ¥ ®¤­®¢à¥¬¥­­®¥ ᮧ¤ ­¨¥ 2 ¨ 3-© áá뫪¨,
+     â.ª ®­¨ ®â«¨ç îâáï «¨èì §­ ª®¬ áà ¢­¥­¨ï}
+     begin 
+      if ((c^.s > hs[i]^.s) and (i=2)) or ((c^.s < hs[i]^.s) and (i=3)) then
+      {�஢¥à塞, ­¥ ­ ¤® «¨ § ¬¥­¨âì £®«®¢ã ­®¢ë¬ í«-⮬}
+       begin
+        c^.next[i] := hs[i];
+        hs[i]:=c;
+       end
+      else {ˆ­ ç¥ ¨é¥¬ ¥¬ã ¬¥áâ® ¢ 㦥 ᮧ¤ ­­®¬ ᯨ᪥}
+       begin
+         n:=hs[i]; {ˆ­¨æ. "¡¥£ã­®ª"}
+
+         while (n<>ts[i]) and
+         (                                      {�®ª  ­¥ ¯®á«¥¤­¨© í«-â,}
+          ((n^.next[i]^.s > c^.s) and (i=2)) or {¨ ¢ë¯®«­ï¥âáï ®âá®àâ¨à®¢ ­­®áâì}
+          ((n^.next[i]^.s < c^.s) and (i=3))    {¯¥à¥¬¥é ¥¬ "¡¥£ã­®ª"}
+         ) do n:=n^.next[i];
+
+         c^.next[i] := n^.next[i]; {‚áâ ¢«ï¥¬ ­ è í«-â ¬¥¦¤ã "¡¥£ã­ª®¬"}
+         n^.next[i] := c;          {¨ á«¥¤ãî騬 §  ­¨¬}
+
+         if n = ts[i] then ts[i] := c; {�ਠ­¥®¡å®¤¨¬®á⨠- ᬥ頥¬ 墮áâ}
+       end; {Š®­¥æ ¤®¡ ¢«¥­¨ï í«-â  ¢ á®àâ.ᯨ᮪}
+     end; {Š®­¥æ 横«  ¤«ï 2-å á®àâ¨à®¢®ª}
+  end; {Š®­¥æ 横«  ç⥭¨ï ä ©« }
+end;{CreateList}
+{------------------------------}     
+Procedure WriteList(var F:text;hs,ts:chains;order:integer);
+{�à®æ¥¤ãà  ¢ë¢®¤  ᯨ᪠, § ¤ ­­®£® hs ¨ ts ¢ ä ©« F
+ Order - ­®¬¥à ᯨ᪠, ¯® ª®â®à®¬ã ¡¥¦ âì}
+var
+ c : Plist;   {�¥£ã­®ª}
+begin
+ c:=hs[order]; {¥£® ¨­¨æ¨ «¨§ æ¨ï}
+ repeat
+   WriteLn(c^.s);   
+   c:=c^.next[order]; {¯à®¤¢¨¦¥­¨¥ ¯® ᯨáªã}
+ until c = ts[order]; {�ਧ­ ª ª®­æ  ᯨ᪠ - ¢ë¢®¤ 墮áâ }
+end;{WriteList}
+{------------------------------}
+{  ƒŽ‹Ž‚�Ž‰ ŒŽ„“‹œ  }
+var
+ heads,tails : chains;   {Œ áá¨¢ë £®«®¢ ¨ 墮á⮢}
+ ch          : integer;  {¯¥à¥¬¥­­ ï ¢ë¡®à  ¢ à¨ ­â  ¢ë¢®¤ }
+begin
+  Assign(input,'4th.txt');
+  {$I-}
+    Reset(INPUT);
+    if IOResult <> 0 then
+     begin
+       WriteLn('Error opening ''4th.txt''');
+       Halt(255);
+     end;
+  {$I+}
+  CreateList(INPUT,Heads,Tails); {‘®§¤ ­¨¥ ᯨ᪠}
+  Close(Input);
+  Assign(Input,'con'); {ˆ­¨æ¨ «¨§ æ¨ï ª« ¢¨ âãàë ­  ¬¥áâ®}
+  Reset(Input);
+
+  WriteLn('‘¯¨á®ª ᮧ¤ ­! ‚¢¥¤¨â¥:');
+  WriteLn('  1 - ­¥ ®âá®àâ¨à®¢ ­ ');
+  WriteLn('  2 - ®âá®àâ¨à®¢ ­ ¯® ã¡ë¢ ­¨î');       {‚뢮¤ ¯à¨£« è¥­¨ï}
+  WriteLn('  3 - ®âá®àâ¨à®¢ ­ ¯® ¢®§à®áâ ­¨î');
+  ch:=0;
+  repeat
+    Write('‚¢¥¤¨â¥ ç¨á«® ®â 1-£® ¤® 3-å: ');   {‡ ¯à®á}
+    Read(ch);
+  until ch in [1..3];
+  WriteLn('‚ë ¢ë¡à «¨ ',msgs[ch]); {‘¨£­ «¨§ æ¨ï ¢ë¡®à }
+  Assign(output,'4th.out');
+  Rewrite(output);
+  if IOResult <> 0 then
+   begin
+     WriteLn('Error opening ''4th.out'' for writing :( ');
+     Halt(254);
+   end;
+  WriteLn('Žà¨£¨­ «:');
+  WriteList(OUTPUT,heads,tails,1);  {‚뢮¤ á­ ç «  ¨á室­®£® ᯨ᪠}
+  WriteLn('�¥§ã«ìâ â:');
+  WriteList(OUTPUT,heads,tails,ch); {‡ â¥¬ - ¢ë¡à ­­®£® ¯®«ì§®¢ â¥«¥¬}
+
+  while Heads[1] <> nil do
+  {Žç¨á⪠ ¢á¥£® ᯨ᪠, Heads[1] - ¡¥£ã­®ª, Tails[1] - ¢à¥¬¥­­ ï ¯¥à¥¬¥­­ ï}
+  begin
+    Tails[1] := Heads[1]^.next[1];
+    Dispose(heads[1]);
+    Heads[1]:=tails[1];
+  end;
+end.

PAS/!SPbSTU/2nd/4TH.txt

@@ -0,0 +1,143 @@
+{�ணࠬ¬  ¤«ï ç⥭¨ï ¨§ ä ©«  áâப ¨ ®¤­®¢à¥¬¬¥­­®¥ ᮧ¤ ­¨¥ «¨­¥©­®£®
+âਭ ¯à ¢«¥­­®£® ᯨ᪠, 1-© - ª ª ¢ ä ©«¥, 2-© ®âá®àâ. ¯® ã¡ë¢, 3-© - ¯® ¢®§à.}
+{Copyright Innocenty Enikeew (YEAR-2000)084/1 17.10.2001}
+type
+ PList = ^TList;
+ chains   = array[1..3] of PList; {Œ áᨢ 㪠§ â¥«¥© ­  í«-âë}
+ TList = record
+   s : string;  {‡­ ç¥­¨¥ í«-â  á¯¨áª .}
+   next : chains; {Œ áᨢ ááë«®ª. 1-© - ­  á«¥¤ãî騩
+                                  2-© - ­  á®àâ¨à®¢ ­­ë© ¯® ã¡ë¢
+                                  3-© - --------\\--------- ¢®§à®áâ}
+ end;
+Const
+ msgs : array [1..3] of string = ('­¥ ®âá®àâ¨à®¢ ­­ë©','®âá®àâ¨à®¢ ­­ë© ¯® ã¡ë¢ ­¨î','®âá®àâ¨à®¢ ­­ë© ¯® ¢®§à®áâ ­¨î');
+  {Œ áᨢ á®®¡é¥­¨© ® á®àâ¨à®¢ª¥}
+{--------------------------------------------------------}
+Procedure CreateList(var F:text;var hs,ts : chains);
+{�à®æ¥¤ãà  ç⥭¨ï í«¥¬¥­â®¢ ¨§ ä ©«  á ®¤­®¢à¥¬¥­­®© á®àâ¨à®¢ª®© ¯® ã¡ë¢ ­¨î
+ ¨ ¢®§à®áâ ­¨î
+ ‚室­ë¥:
+  F  - ⥪áâ®¢ë© ä ©«, ®âªã¤  áç¨â¨¢ îâáï ¤ ­­ë¥
+ ‚ë室­ë¥
+  hs - ¬ áᨢ 㪠§ â¥«¥© ­  £®«®¢ë ᯨ᪮¢
+  ts - ---------//--------- 墮áâë ᯨ᪮¢
+€«£®à¨â¬ à ¡®âë:
+ 1) ‘ç¨â뢠¥âáï ¯¥à¢ë© í«¥¬¥­â, ª®â®àë¬ ¨­¨æ¨ «¨§¨àãîâáï ‚‘… 㪠§ â¥«¨
+ 2) �®ª  ä ©« ­¥ ª®­ç¨âáï, ᮧ¤ ¥¬ ¨ áç¨â뢠¥¬ á«¥¤ãî騩 í«¥¬¥­â. ‡ ¯¨á뢠¥¬ 
+    ¢ 1-© 㪠§ â¥«ì
+ 3) � å®¤¨¬ ¬¥áâ® ¯® ¢®§à áâ ­¨î. ‚áâ ¢«ï¥¬ â㤠, ¯®«ãç ï 2-î áá뫪ã
+ 4) ------\\-------- ã¡ë¢ ­¨î.    ----------\\-----------  3-î
+ 5) �¥à¥å®¤ ­¥ 2
+}
+var
+ i           : integer;  {“ª §ë¢ ¥â ­®¬¥à áá뫪¨}
+ n,c         : PList;    {á - ­®¢ë© ᮧ¤ ­­ë©, n - "¡¥£ã­®ª" ¤«ï ¯®¨áª  ¬¥áâ }
+begin                           
+  New(Hs[1]);                { \ }
+  Hs[2]:=Hs[1];              { | }
+  Hs[3]:=Hs[1];              { | }
+  for i := 1 to 3 do         { | ‘®§¤ ­¨¥ }
+   begin                     { | ¨ ç⥭¨¥ �…�‚ŽƒŽ í«¥¬¥­â }
+    ts[i]:=hs[1];            { | }
+    Hs[1]^.next[i] := nil;   { | }
+   end;                      { | }
+  ReadLn(F,Hs[1]^.s);        { / }
+  while not EOF(F) do       {Žá­®¢­®© 横« áç¨â뢠­¨ï í«¥¬¥­â®¢}
+  begin
+    New(c);for i := 1 to 3 do c^.next[i]:=nil;  {‚뤥«¥­¨¥ ­®¢®£® í«-â  ¨
+                                                 ¨­¨æ¨ «¨§ æ¨ï ¥£® ááë«®ª}
+    ts[1]^.Next[1] := c;     {‡ ­¥á¥¬ ¥£® ¢ ª®­¥æ ¯¥à¢®© 楯®çª¨}
+    ts[1]:=c;                {¨ ᤢ¨­¥¬ ¥¥ 墮áâ}
+    ReadLn(c^.s);
+    for i := 2 to 3 do
+    {„ ­­ë© 横« ®¡ê¥¤¨­ï¥â ¢ ᥡ¥ ®¤­®¢à¥¬¥­­®¥ ᮧ¤ ­¨¥ 2 ¨ 3-© áá뫪¨,
+     â.ª ®­¨ ®â«¨ç îâáï «¨èì §­ ª®¬ áà ¢­¥­¨ï}
+     begin 
+      if ((c^.s > hs[i]^.s) and (i=2)) or ((c^.s < hs[i]^.s) and (i=3)) then
+      {�஢¥à塞, ­¥ ­ ¤® «¨ § ¬¥­¨âì £®«®¢ã ­®¢ë¬ í«-⮬}
+       begin
+        c^.next[i] := hs[i];
+        hs[i]:=c;
+       end
+      else {ˆ­ ç¥ ¨é¥¬ ¥¬ã ¬¥áâ® ¢ 㦥 ᮧ¤ ­­®¬ ᯨ᪥}
+       begin
+         n:=hs[i]; {ˆ­¨æ. "¡¥£ã­®ª"}
+
+         while (n<>ts[i]) and
+         (                                      {�®ª  ­¥ ¯®á«¥¤­¨© í«-â,}
+          ((n^.next[i]^.s > c^.s) and (i=2)) or {¨ ¢ë¯®«­ï¥âáï ®âá®àâ¨à®¢ ­­®áâì}
+          ((n^.next[i]^.s < c^.s) and (i=3))    {¯¥à¥¬¥é ¥¬ "¡¥£ã­®ª"}
+         ) do n:=n^.next[i];
+
+         c^.next[i] := n^.next[i]; {‚áâ ¢«ï¥¬ ­ è í«-â ¬¥¦¤ã "¡¥£ã­ª®¬"}
+         n^.next[i] := c;          {¨ á«¥¤ãî騬 §  ­¨¬}
+
+         if n = ts[i] then ts[i] := c; {�ਠ­¥®¡å®¤¨¬®á⨠- ᬥ頥¬ 墮áâ}
+       end; {Š®­¥æ ¤®¡ ¢«¥­¨ï í«-â  ¢ á®àâ.ᯨ᮪}
+     end; {Š®­¥æ 横«  ¤«ï 2-å á®àâ¨à®¢®ª}
+  end; {Š®­¥æ 横«  ç⥭¨ï ä ©« }
+end;{CreateList}
+{------------------------------}     
+Procedure WriteList(var F:text;hs,ts:chains;order:integer);
+{�à®æ¥¤ãà  ¢ë¢®¤  ᯨ᪠, § ¤ ­­®£® hs ¨ ts ¢ ä ©« F
+ Order - ­®¬¥à ᯨ᪠, ¯® ª®â®à®¬ã ¡¥¦ âì}
+var
+ c : Plist;   {�¥£ã­®ª}
+begin
+ c:=hs[order]; {¥£® ¨­¨æ¨ «¨§ æ¨ï}
+ repeat
+   WriteLn(c^.s);   
+   c:=c^.next[order]; {¯à®¤¢¨¦¥­¨¥ ¯® ᯨáªã}
+ until c = ts[order]; {�ਧ­ ª ª®­æ  ᯨ᪠ - ¢ë¢®¤ 墮áâ }
+end;{WriteList}
+{------------------------------}
+{  ƒŽ‹Ž‚�Ž‰ ŒŽ„“‹œ  }
+var
+ heads,tails : chains;   {Œ áá¨¢ë £®«®¢ ¨ 墮á⮢}
+ ch          : integer;  {¯¥à¥¬¥­­ ï ¢ë¡®à  ¢ à¨ ­â  ¢ë¢®¤ }
+begin
+  Assign(input,'4th.txt');
+  {$I-}
+    Reset(INPUT);
+    if IOResult <> 0 then
+     begin
+       WriteLn('Error opening ''4th.txt''');
+       Halt(255);
+     end;
+  {$I+}
+  CreateList(INPUT,Heads,Tails); {‘®§¤ ­¨¥ ᯨ᪠}
+  Close(Input);
+  Assign(Input,'con'); {ˆ­¨æ¨ «¨§ æ¨ï ª« ¢¨ âãàë ­  ¬¥áâ®}
+  Reset(Input);
+
+  WriteLn('‘¯¨á®ª ᮧ¤ ­! ‚¢¥¤¨â¥:');
+  WriteLn('  1 - ­¥ ®âá®àâ¨à®¢ ­ ');
+  WriteLn('  2 - ®âá®àâ¨à®¢ ­ ¯® ã¡ë¢ ­¨î');       {‚뢮¤ ¯à¨£« è¥­¨ï}
+  WriteLn('  3 - ®âá®àâ¨à®¢ ­ ¯® ¢®§à®áâ ­¨î');
+  ch:=0;
+  repeat
+    Write('‚¢¥¤¨â¥ ç¨á«® ®â 1-£® ¤® 3-å: ');   {‡ ¯à®á}
+    Read(ch);
+  until ch in [1..3];
+  WriteLn('‚ë ¢ë¡à «¨ ',msgs[ch]); {‘¨£­ «¨§ æ¨ï ¢ë¡®à }
+  Assign(output,'4th.out');
+  Rewrite(output);
+  if IOResult <> 0 then
+   begin
+     WriteLn('Error opening ''4th.out'' for writing :( ');
+     Halt(254);
+   end;
+  WriteLn('Žà¨£¨­ «:');
+  WriteList(OUTPUT,heads,tails,1);  {‚뢮¤ á­ ç «  ¨á室­®£® ᯨ᪠}
+  WriteLn('�¥§ã«ìâ â:');
+  WriteList(OUTPUT,heads,tails,ch); {‡ â¥¬ - ¢ë¡à ­­®£® ¯®«ì§®¢ â¥«¥¬}
+
+  while Heads[1] <> nil do
+  {Žç¨á⪠ ¢á¥£® ᯨ᪠, Heads[1] - ¡¥£ã­®ª, Tails[1] - ¢à¥¬¥­­ ï ¯¥à¥¬¥­­ ï}
+  begin
+    Tails[1] := Heads[1]^.next[1];
+    Dispose(heads[1]);
+    Heads[1]:=tails[1];
+  end;
+end.

PAS/!SPbSTU/5th/BINTREE.BAK

@@ -0,0 +1,123 @@
+Program BinTree;
+{�ணࠬ¬  ¤«ï £¥­¥à æ¨¨, ¬®¤¨ä¨æ¨à®¢ ­¨ï, ®â®¡à ¦¥­¨ï ¡¨­ à­®£® ¤¥à¥¢  ¯®¨áª .}
+Uses CRT;
+type
+ PTree = ^TTree;
+ TTree = record
+   key  : integer;
+   L, R : PTree;
+ end;
+{-------------------------}
+Procedure Add(aKey : integer; var aP : PTree);
+begin
+  if aP = nil then
+   begin
+    New(aP);
+    with aP^ do
+     begin
+      key := aKey;
+      l:=nil;
+      r:=nil;
+     end;
+   end
+  else
+   begin
+     if aKey > aP^.Key then Add(aKey,aP^.R) else
+     if aKey < aP^.Key then Add(aKey,aP^.L);
+   end;
+end;{Add}
+{-------------------------}
+Procedure Delete( aKey : integer; var aP:PTree);
+var
+ q : PTree;
+{-}
+ procedure Del(var aP:PTree);
+ begin
+   if aP^.R <> nil then Del(aP^.R)
+   else
+    begin
+      q^.Key := aP^.Key;
+      q := aP;
+      aP := aP^.L;
+    end;
+ end;
+{}
+begin
+ if aP = nil then WriteLn('�«-â  ',aKey, ' ­¥â ¢ ¤¥à¥¢¥!') else
+ if aKey > aP^.Key then Delete(aKey,aP^.R) else
+ if aKey < aP^.Key then Delete(aKey,aP^.L) else
+  begin
+   q := aP;
+   if q^.L = nil then aP := q^.L else
+   if q^.R = nil then aP := q^.R else Del(q^.L);
+   Dispose(q);
+  end;
+end;{Delete}
+{----------------------------}
+Procedure DelAll(var r : PTree);
+begin
+ if r <> nil then begin
+  if (R^.L = nil ) and (R^.R = nil ) then
+  begin
+   Dispose(r);
+   r:=nil;
+  end
+  else
+   begin
+    DelAll(r^.L);
+    DelAll(r^.R);
+    Dispose(r);
+    r:=nil;
+   end;
+  end;
+end;
+{-----------------------}
+Procedure Draw(P:PTree; x , h : word);
+var
+ i : byte;
+begin
+  GotoXY(x, 1 + h * 2);
+  Write(P^.Key);
+  if P^.L <> nil then
+  begin
+    GotoXY(x - (1 shl (4-h))+1,2+h*2);
+    Write(#218);
+    for i:=1 to (1 shl (4-h)-2) do Write(#196);
+    Write(#217);
+    Draw(P^.L, x - (1 shl (4-h)), h+1);
+  end;
+  if P^.R <> nil then
+  begin
+    GotoXY(x+1,2+h*2);
+    Write(#192);
+    for i:=1 to (1 shl (4-h)-2) do Write(#196);
+    Write(#191);
+    Draw(P^.R, x + (1 shl (4-h)), h+1);
+  end;
+end; {Draw}
+{-------------------}
+var
+  c : integer;
+  INP : TEXT;
+  root : PTree;
+begin
+  Assign(INP,'treeval.txt');
+  Reset(INP);
+  root := nil;
+  while (NOT EOF(INP)) do
+  begin
+   Read(INP,c);
+   Add(c,Root);
+  end;
+  ClrScr;
+  Draw(root,40,0);
+  GotoXY(1,24);
+  Write('‚¢¥¤¨â¥ ª®£® 㤠«¨âì: ');
+  Read(c);
+  Delete(c,root);
+  ClrScr;
+  Draw(root,40,0);
+  ReadLn;
+  ReadLn;
+  DelAll(Root);
+end.

PAS/!SPbSTU/5th/BINTREE.PAS

@@ -0,0 +1,123 @@
+Program BinTree;
+{�ணࠬ¬  ¤«ï £¥­¥à æ¨¨, ¬®¤¨ä¨æ¨à®¢ ­¨ï, ®â®¡à ¦¥­¨ï ¡¨­ à­®£® ¤¥à¥¢  ¯®¨áª .}
+Uses CRT;
+type
+ PTree = ^TTree;
+ TTree = record
+   key  : integer;
+   L, R : PTree;
+ end;
+{-------------------------}
+Procedure Add(aKey : integer; var aP : PTree);
+begin
+  if aP = nil then
+   begin
+    New(aP);
+    with aP^ do
+     begin
+      key := aKey;
+      l:=nil;
+      r:=nil;
+     end;
+   end
+  else
+   begin
+     if aKey > aP^.Key then Add(aKey,aP^.R) else
+     if aKey < aP^.Key then Add(aKey,aP^.L);
+   end;
+end;{Add}
+{-------------------------}
+Procedure Delete( aKey : integer; var aP:PTree);
+var
+ q : PTree;
+{-}
+ procedure Del(var aP:PTree);
+ begin
+   if aP^.R <> nil then Del(aP^.R)
+   else
+    begin
+      q^.Key := aP^.Key;
+      q := aP;
+      aP := aP^.L;
+    end;
+ end;
+{}
+begin
+ if aP = nil then WriteLn('�«-â  ',aKey, ' ­¥â ¢ ¤¥à¥¢¥!') else
+ if aKey > aP^.Key then Delete(aKey,aP^.R) else
+ if aKey < aP^.Key then Delete(aKey,aP^.L) else
+  begin
+   q := aP;
+   if q^.L = nil then aP := q^.L else
+   if q^.R = nil then aP := q^.R else Del(q^.L);
+   Dispose(q);
+  end;
+end;{Delete}
+{----------------------------}
+Procedure DelAll(var r : PTree);
+begin
+ if r <> nil then begin
+  if (R^.L = nil ) and (R^.R = nil ) then
+  begin
+   Dispose(r);
+   r:=nil;
+  end
+  else
+   begin
+    DelAll(r^.L);
+    DelAll(r^.R);
+    Dispose(r);
+    r:=nil;
+   end;
+  end;
+end;
+{-----------------------}
+Procedure Draw(P:PTree; x , h : word);
+var
+ i : byte;
+begin
+  GotoXY(x, 1 + h * 2);
+  Write(P^.Key:2);
+  if P^.L <> nil then
+  begin
+    GotoXY(x - (1 shl (4-h))+1,2+h*2);
+    Write(#218);
+    for i:=1 to (1 shl (4-h)-2) do Write(#196);
+    Write(#217);
+    Draw(P^.L, x - (1 shl (4-h)), h+1);
+  end;
+  if P^.R <> nil then
+  begin
+    GotoXY(x+1,2+h*2);
+    Write(#192);
+    for i:=1 to (1 shl (4-h)-2) do Write(#196);
+    Write(#191);
+    Draw(P^.R, x + (1 shl (4-h)), h+1);
+  end;
+end; {Draw}
+{-------------------}
+var
+  c : integer;
+  INP : TEXT;
+  root : PTree;
+begin
+  Assign(INP,'treeval.txt');
+  Reset(INP);
+  root := nil;
+  while (NOT EOF(INP)) do
+  begin
+   Read(INP,c);
+   Add(c,Root);
+  end;
+  ClrScr;
+  Draw(root,40,0);
+  GotoXY(1,24);
+  Write('‚¢¥¤¨â¥ ª®£® 㤠«¨âì: ');
+  Read(c);
+  Delete(c,root);
+  ClrScr;
+  Draw(root,40,0);
+  ReadLn;
+  ReadLn;
+  DelAll(Root);
+end.

PAS/!SPbSTU/5th/TREEVAL.TXT

@@ -0,0 +1 @@
+5 6 2 8 7 1 3 4 9 10

PAS/!SPbSTU/9.PAS

@@ -0,0 +1,244 @@
+{
+ „®áâã¯­ë¥ ®¯¥à æ¨¨:
+  +-*/ - áâ ­¤ àâ­®
+  ^    - ¢®§¢¥¤¥­¨¥ ¢ á⥯¥­ì
+}
+
+const
+ deyst  = ['+','-','*','/','^',')','('];
+
+type
+  pTree = ^tTree;
+  tTree = record
+   operand   : real;
+   operation : char;
+   left  : pTree;
+   right : pTree;
+  end;
+
+ stack = ^tstack;
+ tstack = record
+  t : pTree;
+  n : stack;
+ end;
+{------------------------------}
+Procedure CreateBranch(var aStack : stack;aCurOper : char);
+var
+ aN : pTree;
+ aL : stack;
+begin
+ if (aStack = nil) or (aStack^.n = nil) then
+  begin
+   WriteLn('Error in operators');
+   Halt(255);
+  end;
+ New(aN);
+ with aN^ do
+  begin
+   operation := aCurOper;
+   Right:=aStack^.t;
+   aL := aStack;
+   aStack := aStack^.n;
+   Dispose(aL);
+   Left :=aStack^.t;
+   aL:=aStack;
+   aStack := aStack^.n;
+   Dispose(aL);
+   aL:=aStack;
+  end;
+ New(aStack);
+ aStack^.n := aL;
+ aStack^.t := aN;
+end;
+{------------------------------}
+function GetPrior(a:char):integer;
+begin
+  case a of 
+   '(':GetPrior:=5;
+   ')':GetPrior:=5;
+   '+':GetPrior:=10;
+   '-':GetPrior:=12;
+   '*':GetPrior:=20;
+   '/':GetPrior:=20;
+   '^':GetPrior:=30;
+   else begin
+         WriteLN('Sorry, undefined operation, ''',a,'''');
+        end;
+  end;
+end;
+{------------------------------}
+function GetToken(var aStr:string;var aPos:byte):string;
+var
+ ret:string;                   
+begin
+ ret:='';
+ while (aStr[aPos] = ' ') and (aPos <= ord(aStr[0])) do inc(aPos);
+ if aStr[aPos] in Deyst then
+ begin
+  ret := aStr[aPos];
+  inc(aPos)
+ end
+ else
+  while (aStr[aPos] in ['0'..'9','.']) and (aPos <= ord(aStr[0])) do
+  begin
+   ret:=ret + aStr[aPos];
+   inc(aPos);
+  end;
+ while (aStr[aPos] = ' ') and (aPos <= ord(aStr[0])) do inc(aPos);
+ GetToken:=ret;
+end;
+{------------------------------}
+Function CreateTree(aInp:string):pTree;
+var
+
+ operations : string;
+ token      : string;
+ opPos,sPos : byte;
+ LastOprtn  : Boolean;
+ retcode    : integer;
+ TreeStack  : stack;
+ NewEl      : stack;
+begin
+ sPos:=1;
+ operations[0] := #255;
+ LastOprtn := true;
+ TreeStack := nil;
+ opPos := 0;
+ while sPos <= ord(aInp[0]) do
+ begin
+  Token := GetToken(aInp,sPos);
+  if Token[1] in Deyst then
+  begin
+   if Token[1] <> '(' then
+    if LastOprtn then
+     begin
+      WriteLn('Error in input: ',aInp);
+      WriteLn('Expected operation at position near ''',Copy(aInp,sPos-Length(Token),5),'''');
+      Halt(236);
+     end
+    else
+     while (opPos > 0) and (GetPrior(Token[1]) < GetPrior(operations[opPos])) do
+      begin
+       CreateBranch(TreeStack,operations[opPos]);
+       dec(opPos);
+      end;
+   if Token[1] <> ')' then 
+    begin
+     inc(opPos);
+     operations[opPos] := Token[1];
+     LastOprtn := true;
+    end
+   else
+    Dec(opPos);
+  end
+  else
+   begin
+    if not LastOprtn then
+     begin
+      WriteLn('Error in input: ',aInp);
+      WriteLn('Expected operand at position near ''',Copy(aInp,sPos-Length(Token),5),'''');
+      Halt(236);
+     end;
+    New(NewEl);
+    NewEl^.n := TreeStack;
+    new(NewEl^.t);
+    with NewEl^.t^ do
+    begin
+     left:=nil;
+     right:=nil;
+     Val(Token,operand,retcode);
+     operation := ' ';
+     if retcode <> 0 then
+      begin
+       WriteLn('Error in input: ',aInp);
+       WriteLn('in position ',sPos-Length(Token));
+       Halt(255);
+      end;
+    end;
+    TreeStack := NewEl;
+    LastOprtn := False;
+   end;
+  end;
+
+  while opPos > 0 do
+   begin
+    CreateBranch(TreeStack,operations[opPos]);
+    dec(opPos);
+   end;
+ CreateTree := TreeStack^.t;
+ Dispose(TreeStack);   
+end;
+{------=-=-=-=--==-=-=-=--=--==--=}
+Procedure ToPostfix(aT:pTree;var aOut:string);
+var
+ aStr : string[13];
+begin
+ if aT = nil then exit;
+ ToPostfix(aT^.Left,aOut);
+ ToPostfix(aT^.Right,aOut);
+ if aT^.Operation = ' ' then
+  begin
+   Str(aT^.operand:0:0,aStr);
+   aOut:=aOut+aStr+' ';
+  end
+ else
+   aOut:=aOut+aT^.Operation+' ';  
+end;
+{-----------------------}
+Function aInb(a,b:real):real;
+begin
+ if a > 0 then
+  aInb:=Exp(b*Ln(a))
+ else
+  aInb:=0;
+end;
+{-----------------------}
+Function CalculateTree(aT: pTree):real;
+begin
+ if aT=nil then exit;
+ Case aT^.Operation of
+   ' ': CalculateTree:=aT^.Operand;
+   '+': CalculateTree:=CalculateTree(aT^.Left) + CalculateTree(aT^.Right);
+   '-': CalculateTree:=CalculateTree(aT^.Left) - CalculateTree(aT^.Right);
+   '*': CalculateTree:=CalculateTree(aT^.Left) * CalculateTree(aT^.Right);
+   '/': CalculateTree:=CalculateTree(aT^.Left) / CalculateTree(aT^.Right);
+   '^': CalculateTree:=aInb(CalculateTree(aT^.Left),CalculateTree(aT^.Right));
+ end;
+end;
+{-----------------------}
+Procedure DisposeTree(aT : pTree);
+begin
+  if aT <> nil then 
+  Begin
+   DisposeTree(aT^.Left);
+   DisposeTree(aT^.Right);
+   Dispose(aT);
+  end;
+end;
+{-------}
+var
+ aIn : string;
+ aOut : string;
+ Tree :pTree;
+begin
+ Assign(input,'9.txt');
+ {$I-}
+  Reset(input);
+  if IOResult <> 0 then
+   begin
+    WriteLn('File 9.txt not found!');
+    halt(255);
+   end;
+ {$I+}
+ Readln(aIn);
+ Close(input);
+ aOut :='';
+ Tree := CreateTree(aIn);
+ ToPostfix(Tree,aOut);
+ Assign(OutPut,'9.out');
+ Rewrite(OutPut);
+ WriteLn('‚ëà ¦¥­¨¥ ¢ ¯®áâ䨪á. ä®à¬¥: ',aOut);
+ WriteLn('�¥§ã«ìâ â: ',CalculateTree(Tree):0:3);
+ Close(output);
+ DisposeTree(Tree);
+end.

PAS/!SPbSTU/9.TXT

@@ -0,0 +1 @@
+1^6+2-3*4/5

PAS/!SPbSTU/Boris/10.PAS

@@ -0,0 +1,170 @@
+USES Graph;
+Type
+  PBTree = ^TBTree;
+  TBTree = record
+    info : string[30];
+    Left : PBTree;
+    Right: PBTree;
+  end;
+
+    ps  = ^el;
+    el  = record
+        data : integer;
+        prev : ps;
+    end;
+Var
+  inp : string;
+  p   : byte;
+  mh  : byte;
+
+{---------------------------------}
+Procedure DelBranch(br:PBTree);
+begin
+  if br^.left  <> nil then DelBranch(br^.left);
+  if br^.right <> nil then DelBranch(br^.right);
+  Dispose(br);
+end;{DelBranch}
+
+{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-}
+Function GetToken:string;
+var
+ ret : string[30];
+begin
+ ret :='';
+ while inp[p] = ' ' do inc(p);
+ while (not (inp[p] in [' ','(',')'])) and (p <= ord(inp[0])) do
+  begin
+   ret := ret+inp[p];
+   inc(p);
+  end;
+ While (inp[p] = ' ') and (p <= ord(inp[0])) do inc(p);
+ GetToken := ret;
+end;
+{--------------------}
+Procedure Create(TR:PBTree);
+var
+ aT : string[20];
+begin
+ tr^.left:=nil;
+ tr^.right:=nil;
+ while inp[p] = ' ' do inc(p);
+ 
+ if (copy(inp,p,3)<>'NOT') or 
+    (copy(inp,p,3)<>'not') then
+ begin
+  New(Tr^.left);
+  Tr^.left^.right:=nil;
+  Tr^.left^.left:=nil;
+  if inp[p] = '(' then 
+   begin 
+    inc(p);
+    Create(tr^.left);
+   end
+  else 
+   begin
+    aT:=GetToken;
+    if (aT<>'NOT') and (aT<>'AND') and (aT <> 'OR') and 
+       (aT<>'not') and (aT<>'and') and (aT <> 'or') then
+     tr^.left^.info := aT
+    else
+     begin
+      WriteLn('Get operation, when expected operand: ', aT);
+      Halt(255);
+     end;
+   end;
+ end;
+
+ tr^.info := GetToken;
+ if  (tr^.info <> 'AND') and (tr^.info <> 'and') and
+     (tr^.info <> 'NOT') and (tr^.info <> 'not') and
+     (tr^.info <> 'OR')  and (tr^.info <> 'or')  then
+    begin
+      WriteLn('Error at pos ',p - Length(tr^.info));
+      Halt(255);
+    end;
+    
+ new(tr^.right);
+ Tr^.right^.right:=nil;
+ Tr^.right^.left:=nil;
+ if (inp[p]='(') then 
+  begin 
+   inc(p);
+   Create(tr^.right) 
+  end
+ else 
+   begin
+    aT:=GetToken;
+    if aT = '' then
+     begin
+      WriteLn('No operand, when expected, pos ',p);
+      Halt(255);
+     end;
+    if ((aT<>'NOT') and (aT<>'AND') and (aT <> 'OR') and
+        (aT<>'not') and (aT<>'and') and (aT <> 'or')) then
+     tr^.right^.info := aT
+    else
+     begin
+      WriteLn('Get operation, when expected operand: ', aT);
+      Halt(255);
+     end;
+   end;
+
+ if (inp[p]=')') then inc(p);
+end;
+{---=--=--=-=-=-=-=-=---=-=-=-=-=--}
+Procedure DrawTree(aT:PBTree;x,y,h,dy:word);
+begin
+ if aT = nil then exit;
+ SetTextJustify(CenterText,BottomText);
+ OutTextXY(x,y,aT^.info);
+ if aT^.left <> nil then
+  begin
+    Line(x,y+1,x-(GetMaxX shr h),y+dy-1-TextHeight(at^.left^.info));
+    DrawTree(at^.left, x-(GetMaxX shr h),y+dy,h+1,dy);
+  end;
+ if aT^.right <> nil then
+  begin
+    Line(x,y+1,x+(GetMaxX shr h),y+dy-1-TextHeight(at^.right^.info));
+    DrawTree(at^.right,x+(GetMaxX shr h),y+dy,h+1,dy);
+  end;
+end;
+{=======================}
+Function Height(aT:PBTree;ch:byte):byte;
+begin
+if aT = nil then exit;
+ Height :=  Height(at^.left,ch+1);
+ Height :=  height(at^.right,ch+1);
+ if ch > mh then mh := ch;
+ Height := mh;
+end;
+{--------------}
+var
+  tree: PBTree;
+  grD,grM : integer;
+Begin
+  New(Tree);
+  Tree^.left:=nil;
+  Tree^.right:=nil;
+  p:=1;
+  mh:=0;
+ Assign(input,'10.txt');
+ {$I-}
+ Reset(input);
+ {$I+}
+ if IOResult <> 0 then
+ begin
+  WriteLN('File 10.txt not found!');
+  Halt(255);
+ end;
+  readln(inp);
+ Close(Input);
+ Assign(input,'CON');
+ Reset(input);
+  Create(tree);
+  grD:=Detect;
+InitGraph(grD,grM,'');
+  DrawTree(Tree,GetMaxX div 2,TextHeight(tree^.info)+20,2,(GetMaxY-20) div Height(Tree,1));
+  ReadLn;
+CloseGraph;           
+  DelBranch(tree);
+End.

PAS/!SPbSTU/Boris/10.txt

@@ -0,0 +1 @@
+Hello or (world AND (me OR (my AND I)))

PAS/!SPbSTU/Boris/7/br7/BR7.PAS

@@ -0,0 +1,104 @@
+const
+  Len   = 20;
+  High  = 10;
+  Inp1  = 'input1.txt';
+  Inp2  = 'input2.txt';
+  Out1  = 'output1.txt';
+type
+ Pty = ^ty;
+ ty = record
+   name : Char;
+   next : Pty;
+ end;
+
+var
+  Root1,Root2,Nroot       : Pty;
+  f1,f2                   : text;
+{--------------------------------} {Finde Spase For New Iteme and includ it}
+procedure Sort(var NRoot,Tec : pty;posl : Pty);
+var
+Pred,sled : Pty;
+begin
+  if Tec^.name < Nroot^.name Then begin
+     Tec^.next := Nroot;
+     Nroot := Tec;
+  end
+  else begin
+     Pred :=  Nroot;
+     Sled := Nroot^.next;
+     while (Tec^.name >= Sled^.name) and (Sled <> Posl) do begin
+        Pred := Sled;
+        Sled := Sled^.next;
+     end;
+     pred^.next := Tec;
+     Tec^.next  := Sled;
+  end;
+end;
+{--------------------------------}
+
+{read m from file==========================================}{P1}
+Procedure ReadM(var root : pty;inp : string);
+var
+Tec,Pred : Pty;
+
+begin
+  Assign(f1,Inp);
+  Reset(f1);
+  New(tec);
+  Read(f1,Tec^.Name);
+  Root := Tec;
+  Root^.next := nil;
+  Pred := Tec;
+  While not(Eof(F1)) do begin
+    New(Tec);
+    Read(f1,Tec^.Name);
+    Sort(Root,Tec,nil);
+  end;
+  close(f1);
+end;
+{==========================================}
+{==========================================}    {p2}
+Procedure OuttoFils(Root : pty);
+begin
+  Assign(F2,Out1);
+  ReWrite(f2);
+
+  {write to files}
+  while root<>nil do Begin
+    Write(f2,Root^.name);
+    root := root^.next;
+  end;
+
+  close(f2);
+end;
+{==========================================}
+Procedure P3(Var Root1,Root2,NewRoot : pty);      {p3}
+var
+  Tec,Sled : Pty;
+begin
+  NewRoot := Root1;
+  Tec := Root1^.next;
+  While Tec^.next <> nil do begin
+    Tec := Tec^.next;
+  end;
+  Tec^.next := Root2;
+  Tec  := Root1;
+  Sled := Root1^.next;
+
+  While Sled <> nil do begin
+    If Tec^.name > Sled^.name Then begin
+         Tec^.next := Sled^.next;
+         Sort(Root1,Sled,Sled^.next);
+    end;
+    Tec := Sled;
+    Sled :=Sled^.next;
+  end;
+
+end;
+{==========================================}
+begin
+  ReadM(Root1,inp1);
+  ReadM(Root2,inp2);
+  P3(Root1,Root2,NRoot);
+  OuttoFils(NRoot);
+end.

PAS/!SPbSTU/Boris/7/br7/BR7_1.PAS

@@ -0,0 +1,91 @@
+const
+  Inp1  = 'input1.txt';
+  Inp2  = 'input2.txt';
+  Out1  = 'output1.txt';
+type
+ Pty = ^ty;
+ ty = record
+   name : Char;
+   next : Pty;
+ end;
+
+var
+  Root1,Root2,Nroot       : Pty;
+  f1,f2                   : text;
+{--------------------------------------------}
+procedure Insert(var NRoot:pty; Tec : pty);
+var
+Pred,sled : Pty;
+begin
+  if Tec^.name < Nroot^.name Then begin
+     Tec^.next := Nroot;
+     Nroot := Tec;
+  end
+  else begin
+     Pred :=  Nroot;
+     Sled := Nroot^.next;
+     while (Tec^.name >= Sled^.name) and (Sled <> nil) do begin
+        Pred := Sled;
+        Sled := Sled^.next;
+     end;
+     pred^.next := Tec;
+     Tec^.next  := Sled;
+  end;
+end;
+{--------------------------------}
+
+{read m from file==========================================}{P1}
+Procedure ReadM(var root : pty;inp : string);
+var
+Tec : Pty;
+
+begin
+  Assign(f1,Inp);
+  Reset(f1);
+  New(tec);
+  Read(f1,Tec^.Name);
+  Root := Tec;
+  Root^.next := nil;
+  While not(Eof(F1)) do begin
+    New(Tec);
+    Read(f1,Tec^.Name);
+    Insert(Root,Tec);
+  end;
+  close(f1);
+end;
+{==========================================}
+{==========================================}    {p2}
+Procedure OuttoFils(Root : pty);
+begin
+  Assign(F2,Out1);
+  ReWrite(f2);
+
+  {write to files}
+  while root<>nil do Begin
+    Write(f2,Root^.name);
+    root := root^.next;
+  end;
+
+  close(f2);
+end;
+{==========================================}
+Procedure P3(Root1,Root2:pty;var NewRoot : pty);      {p3}
+var
+  Tec,Sled : Pty;
+begin
+  NewRoot := Root1;
+
+  Tec := Root2;
+  While Tec <> nil do begin
+    Sled := Tec^.next;
+    insert(NewRoot,Tec);
+    Tec := Sled;
+  end;
+end;
+{==========================================}
+begin
+  ReadM(Root1,inp1);
+  ReadM(Root2,inp2);
+  P3(Root1,Root2,NRoot);
+  OuttoFils(NRoot);
+end.

PAS/!SPbSTU/Boris/7/br7/INPUT1.TXT

@@ -0,0 +1 @@
+A

PAS/!SPbSTU/Boris/7/br7/INPUT2.TXT

@@ -0,0 +1 @@
+BZ

PAS/!SPbSTU/Boris/7/br7/OUTPUT1.TXT

@@ -0,0 +1 @@
+ABZ

PAS/!SPbSTU/Boris/8/br8/BR8.PAS

@@ -0,0 +1,117 @@
+const
+  Inp1  = 'inpit1.txt';
+  Inp2  = 'input2.txt';
+  Out1  = 'output1.txt';
+type
+ Pty = ^ty;
+ ty = record
+   name1 : String[10];
+   Name2 : String[10];
+   next : Pty;
+ end;
+var
+  Root1,Root2             : Pty;
+  f1,f2                   : text;
+{==========================================}{P1}
+Procedure ReadM(var root : pty;inp : string);
+var
+Tec,Pred : Pty;
+S        : string;
+I        : integer;
+begin
+  Assign(f1,Inp);
+  Reset(f1);
+  New(tec);
+  Readln(f1,S);
+  I := Pos(' ',S);
+  if I > 10 Then Begin
+     Write('Too Long name');
+     Halt(255);
+  end;
+  Tec^.Name1 := Copy(S,1,I-1);
+
+  if Length(s)-I > 10 Then begin
+     Write('Too Long Surname');
+     Halt(255);
+  end;
+
+  Tec^.Name2 := Copy(S,I+1,Length(S)-I);
+
+  Root := Tec;
+  Root^.next := nil;
+  Pred := Tec;
+  While not(Eof(F1)) do begin
+    New(Tec);
+    Readln(f1,S);
+    I := Pos(' ',S);
+    if I > 10 Then Begin
+       Write('Too Long name');
+       Halt(255);
+    end;
+    Tec^.Name1 := Copy(S,1,I-1);
+
+    if Length(s)-I > 10 Then begin
+     Write('Too Long Surname');
+     Halt(255);
+    end;
+
+    Tec^.Name2 := Copy(S,I+1,Length(S)-I);
+    Pred^.next := Tec;
+    Pred := Tec;
+    Tec^.Next := nil;
+  end;
+  close(f1);
+end;
+{==========================================}
+{==========================================}    {p2}
+Procedure OuttoFils(Root : pty;Out : string);
+begin
+  Assign(F2,Out);
+  ReWrite(f2);
+
+  while root<>nil do Begin
+    WriteLn(f2,Root^.name1,' ',Root^.name2);
+    root := root^.next;
+  end;
+
+  close(f2);
+end;
+{==========================================}
+Procedure P3(Var Root1,Root2 : pty);      {p3}
+var
+Tec,Sled,Pred : Pty;
+begin
+ Tec := Root2;
+ While Tec <> Nil do begin
+   If (Tec^.name1 = Root1^.name1) and (Tec^.name2 = Root1^.name2) Then
+   begin
+     Sled := Root1;
+     Root1 := Root1^.next;
+     dispose(Sled);
+   end
+   else begin
+     Pred := Root1;
+     Sled := Root1^.next;
+     While Sled<> Nil do begin
+       If (Tec^.name1 = Sled^.name1) and (Tec^.name2 = Sled^.name2) Then
+       begin
+          Pred^.next := Sled^.next;
+          Dispose(Sled);
+          Sled := Pred^.next;
+       end
+       else begin
+         Pred := Sled;
+         Sled := Sled^.next;
+       end;
+     end;
+     Tec := Tec^.next;
+   end;
+ end;
+end;
+{==========================================}
+begin
+  ReadM(Root1,inp1);
+  ReadM(Root2,inp2);
+  P3(Root1,Root2);
+  OuttoFils(Root1,Out1);
+end.

PAS/!SPbSTU/Boris/8/br8/INPIT1.txt

@@ -0,0 +1,4 @@
+Petr Petrov
+Ivan Vasilev
+Vasya Sidorov
+Petya Lubov

PAS/!SPbSTU/Boris/8/br8/INPUT2.txt

@@ -0,0 +1,3 @@
+Fedr Vasiliev
+Vasya Sidorov
+Petya Lubov

PAS/!SPbSTU/Boris/8/br8/output1.txt

@@ -0,0 +1,2 @@
+Petr Petrov
+Ivan Vasilev

PAS/!SPbSTU/Boris/9.OUT

@@ -0,0 +1,2 @@
+‚כא ¦¥­¨¥ ¢ ¯®בגה¨×ב. ה®א¬¥: 9 3 - 8 * 1 + 2 ^ 
+�¥§ד«לג ג: 2401.000

PAS/!SPbSTU/Boris/9.PAS

@@ -0,0 +1,243 @@
+{
+ „®áâã¯­ë¥ ®¯¥à æ¨¨:
+  +-*/ - áâ ­¤ àâ­®
+  ^    - ¢®§¢¥¤¥­¨¥ ¢ á⥯¥­ì
+}
+
+const
+ deyst  = ['+','-','*','/','^',')','('];
+
+type
+  pTree = ^tTree;
+  tTree = record
+   operand   : real;
+   operation : char;
+   left  : pTree;
+   right : pTree;
+  end;
+
+ stack = ^tstack;
+ tstack = record
+  t : pTree;
+  n : stack;
+ end;
+{------------------------------}
+Procedure CreateBranch(var aStack : stack;aCurOper : char);
+var
+ aN : pTree;
+ aL : stack;
+begin
+ if (aStack = nil) or (aStack^.n = nil) then
+  begin
+   WriteLn('Error in operators');
+   Halt(255);
+  end;
+ New(aN);
+ with aN^ do
+  begin
+   operation := aCurOper;
+   Right:=aStack^.t;
+   aL := aStack;
+   aStack := aStack^.n;
+   Dispose(aL);
+   Left :=aStack^.t;
+   aL:=aStack;
+   aStack := aStack^.n;
+   Dispose(aL);
+   aL:=aStack;
+  end;
+ New(aStack);
+ aStack^.n := aL;
+ aStack^.t := aN;
+end;
+{------------------------------}
+function GetPrior(a:char):integer;
+begin
+  case a of 
+   '(':GetPrior:=5;
+   ')':GetPrior:=5;
+   '+':GetPrior:=10;
+   '-':GetPrior:=10;
+   '*':GetPrior:=20;
+   '/':GetPrior:=20;
+   '^':GetPrior:=30;
+   else begin
+         WriteLN('Sorry, undefined operation, ''',a,'''');
+        end;
+  end;
+end;
+{------------------------------}
+function GetToken(var aStr:string;var aPos:byte):string;
+var
+ ret:string;                   
+begin
+ ret:='';
+ while (aStr[aPos] = ' ') and (aPos <= ord(aStr[0])) do inc(aPos);
+ if aStr[aPos] in Deyst then
+ begin
+  ret := aStr[aPos];
+  inc(aPos)
+ end
+ else
+  while (aStr[aPos] in ['0'..'9','.']) and (aPos <= ord(aStr[0])) do
+  begin
+   ret:=ret + aStr[aPos];
+   inc(aPos);
+  end;
+ while (aStr[aPos] = ' ') and (aPos <= ord(aStr[0])) do inc(aPos);
+ GetToken:=ret;
+end;
+{------------------------------}
+Function CreateTree(aInp:string):pTree;
+var
+
+ operations : string;
+ token      : string;
+ opPos,sPos : byte;
+ LastOprtn  : Boolean;
+ retcode    : integer;
+ TreeStack  : stack;
+ NewEl      : stack;
+begin
+ sPos:=1;
+ operations[0] := #255;
+ LastOprtn := true;
+ TreeStack := nil;
+ opPos := 0;
+ while sPos <= ord(aInp[0]) do
+ begin
+  Token := GetToken(aInp,sPos);
+  if Token[1] in Deyst then
+  begin
+   if Token[1] <> '(' then
+    if LastOprtn then
+     begin
+      WriteLn('Error in input: ',aInp);
+      WriteLn('Expected operation at position near ''',Copy(aInp,sPos-Length(Token),5),'''');
+      Halt(236);
+     end
+    else
+     while (opPos > 0) and (GetPrior(Token[1]) < GetPrior(operations[opPos])) do
+      begin
+       CreateBranch(TreeStack,operations[opPos]);
+       dec(opPos);
+      end;
+   if Token[1] <> ')' then 
+    begin
+     inc(opPos);
+     operations[opPos] := Token[1];
+     LastOprtn := true;
+    end
+   else
+    Dec(opPos);
+  end
+  else
+   begin
+    if not LastOprtn then
+     begin
+      WriteLn('Error in input: ',aInp);
+      WriteLn('Expected operand at position near ''',Copy(aInp,sPos-Length(Token),5),'''');
+      Halt(236);
+     end;
+    New(NewEl);
+    NewEl^.n := TreeStack;
+    new(NewEl^.t);
+    with NewEl^.t^ do
+    begin
+     left:=nil;
+     right:=nil;
+     Val(Token,operand,retcode);
+     operation := ' ';
+     if retcode <> 0 then
+      begin
+       WriteLn('Error in input: ',aInp);
+       WriteLn('in position ',sPos-Length(Token));
+       Halt(255);
+      end;
+    end;
+    TreeStack := NewEl;
+    LastOprtn := False;
+   end;
+  end;
+  while opPos > 0 do
+   begin
+    CreateBranch(TreeStack,operations[opPos]);
+    dec(opPos);
+   end;
+ CreateTree := TreeStack^.t;
+ Dispose(TreeStack);   
+end;
+{------=-=-=-=--==-=-=-=--=--==--=}
+Procedure ToPostfix(aT:pTree;var aOut:string);
+var
+ aStr : string[13];
+begin
+ if aT = nil then exit;
+ ToPostfix(aT^.Left,aOut);
+ ToPostfix(aT^.Right,aOut);
+ if aT^.Operation = ' ' then
+  begin
+   Str(aT^.operand:0:0,aStr);
+   aOut:=aOut+aStr+' ';
+  end
+ else
+   aOut:=aOut+aT^.Operation+' ';  
+end;
+{-----------------------}
+Function aInb(a,b:real):real;
+begin
+ if a > 0 then
+  aInb:=Exp(b*Ln(a))
+ else
+  aInb:=0;
+end;
+{-----------------------}
+Function CalculateTree(aT: pTree):real;
+begin
+ if aT=nil then exit;
+ Case aT^.Operation of
+   ' ': CalculateTree:=aT^.Operand;
+   '+': CalculateTree:=CalculateTree(aT^.Left) + CalculateTree(aT^.Right);
+   '-': CalculateTree:=CalculateTree(aT^.Left) - CalculateTree(aT^.Right);
+   '*': CalculateTree:=CalculateTree(aT^.Left) * CalculateTree(aT^.Right);
+   '/': CalculateTree:=CalculateTree(aT^.Left) / CalculateTree(aT^.Right);
+   '^': CalculateTree:=aInb(CalculateTree(aT^.Left),CalculateTree(aT^.Right));
+ end;
+end;
+{-----------------------}
+Procedure DisposeTree(aT : pTree);
+begin
+  if aT <> nil then 
+  Begin
+   DisposeTree(aT^.Left);
+   DisposeTree(aT^.Right);
+   Dispose(aT);
+  end;
+end;
+{-------}
+var
+ aIn : string;
+ aOut : string;
+ Tree :pTree;
+begin
+ Assign(input,'9.txt');
+ {$I-}
+  Reset(input);
+  if IOResult <> 0 then
+   begin
+    WriteLn('File 9.txt not found!');
+    halt(255);
+   end;
+ {$I+}
+ Readln(aIn);
+ Close(input);
+ aOut :='';
+ Tree := CreateTree(aIn);
+ ToPostfix(Tree,aOut);
+ Assign(OutPut,'9.out');
+ Rewrite(OutPut);
+ WriteLn('‚ëà ¦¥­¨¥ ¢ ¯®áâ䨪á. ä®à¬¥: ',aOut);
+ WriteLn('�¥§ã«ìâ â: ',CalculateTree(Tree):0:3);
+ Close(output);
+ DisposeTree(Tree);
+end.

PAS/!SPbSTU/Boris/9.txt

@@ -0,0 +1 @@
+((9 - 3) * 8 + 1) ^ 2

PAS/!SPbSTU/Boris/Graph/POOL2.PAS

@@ -0,0 +1,437 @@
+uses Graph,CRT;
+
+CONST
+ TeamSize = 4;
+ SwimmerRad=4;
+ PoolX1   = 30;
+ PoolY1   = 50;
+ PoolSX   = 500;
+ PoolSY   = 200;
+var
+ Tick      : longint Absolute $0040:$006c;
+
+type
+ EDo = (WAITING, SWIM_NEXT, SWIMMING_F, SWIMMING_B, DONE);
+
+ PTeam = ^CTeam;
+
+ CSwimmer = object
+  Name    : String[40];
+  Team    : PTeam;
+  Number  : Integer;
+  Speed   : real;
+  V0,V1   : real;
+  Doing   : EDo;
+  Pos     : real;
+  Constructor Init(aName:String;aT:PTeam;aNum:integer);
+  Procedure SetSpeed(aV0,aV1:real);
+  Procedure Frame(aT:Real);
+  Procedure Draw(aOrder:integer);
+  Procedure Return;
+  Procedure   Swim;
+ end;
+
+ PSwimmer = ^CSwimmer;
+ PWorld   = ^CWorld;
+
+ CTeam = object
+  Name      : string[30];
+  Number    : integer;
+  World     : PWorld;
+  TotalDist : real;
+  maxDist   : real;
+  Swimmers  : array [1..TeamSize] of PSwimmer;
+  NextNumber: integer;
+  ifDone    : boolean;
+  AllTime   : real;
+  Constructor Init(aW:PWorld;aName:string;aNum:word);
+  Procedure   Draw;
+  Procedure   Frame(aTime:real);
+  Procedure   SwimNext;
+ end;
+
+ TLetter  = record
+  Width  : word;
+  Height : word;
+  Data   : pointer;
+  Size   : word;
+ end;
+
+ CWorld = object
+  Numbers   : array [0..9] of TLetter;
+  AllRelay  : array [0..3] of PTeam;
+  LWidth    : word;
+  LeadTeam,Leader : byte;
+  Time,LTime: real;
+  BegTick   : longint;
+  Play : boolean;
+  Table  : array [1..4] of Byte;
+  TPos   : word;
+  Constructor Init;
+  Procedure DrawPool;
+  Procedure InitLetters;
+  Procedure DrawTime(aTime:real);
+  Procedure DrawLeader;
+  Procedure Work;
+  Procedure FinishTeam(aNum:word);
+ end;
+ 
+Procedure CWorld.DrawPool;
+var i,j : integer;
+begin
+  SetFillStyle(SolidFill,White);
+  Bar(PoolX1-20,PoolY1-20,PoolX1+PoolSX+20,PoolY1+PoolSY+20);
+  SetColor(LightGray);
+  Line(PoolX1-20,PoolY1-10,PoolX1+PoolSX+20,PoolY1-10);
+  Line(PoolX1-20,PoolY1+PoolSY+10,PoolX1+PoolSX+20,PoolY1+PoolSY+10);
+
+  Line(PoolX1-10,PoolY1-20,PoolX1-10,PoolY1+PoolSY+20);
+  Line(PoolX1+PoolSX+10,PoolY1-20,PoolX1+PoolSX+10,PoolY1+PoolSY+20);
+  for j := 1 to (PoolSX div 10)+1 do
+   begin
+    Line(PoolX1-10+j*10,PoolY1-20,PoolX1-10+j*10,PoolY1);
+    Line(PoolX1-10+j*10,PoolY1+PoolSY,PoolX1-10+j*10,PoolY1+PoolSY+20);
+   end;
+  for j := 1 to (PoolSY div 10)+1 do
+   begin
+    Line(PoolX1-20,PoolY1-10+j*10,PoolX1,PoolY1-10+j*10);
+    Line(PoolX1+PoolSX,PoolY1-10+j*10,PoolX1+PoolSX+20,PoolY1-10+j*10);
+   end;
+  SetFillStyle(SolidFill,LightBlue);
+  Bar(PoolX1,PoolY1,PoolX1+PoolSX,PoolY1+PoolSY);
+  for i := 1 to 3 do
+   for j := 1 to 24 do
+    begin
+     if odd(i+j) then SetFillStyle(SolidFill,Red) else SetFillStyle(SolidFill,White);
+     FillEllipse(PoolX1+j*(PoolSX div 25),PoolY1+i*(PoolSY div 4),3,3);
+    end;
+end;
+
+Procedure CWorld.InitLetters;
+var
+ i   : integer;
+ pos : word;
+ s   : string[4];
+begin
+  SetTextStyle(SansSerifFont,HorizDir,4);
+  SetTextJustify(LeftText,TopText);
+  SetColor(Green);
+  LWidth := TextWidth('8');
+  s[0] := #1;
+  pos := 0;
+  for i := 0 to 9 do
+   begin
+     s[1] := chr(i+$30);
+     OutTextXY(pos,100,S);
+     with numbers[i] do
+      begin
+       Width := TextWidth(S);
+       Height := TextHeight(S);
+       Size := ImageSize(pos,100,pos+Width,100+Height);
+       GetMem(Data,Size);
+       GetImage(pos,100,pos+Width,100+Height,Data^);
+       inc(Pos,Width);
+      end;
+   end;
+   ClearDevice;
+end;
+
+Procedure CSwimmer.Draw(aOrder:integer);
+begin
+ SetFillStyle(SolidFill,Number+Team^.Number);
+ case Doing of
+   SWIM_NEXT:
+    FillEllipse(PoolX1+PoolSX+5,PoolY1+round((Team^.Number+0.5)*(PoolSY/4.0)),
+                SwimmerRad,SwimmerRad);
+   WAITING :
+    FillEllipse(PoolX1+PoolSX+25,PoolY1+round((Team^.Number+0.2)*PoolSY/4)+aOrder*8,
+                SwimmerRad,SwimmerRad);
+   SWIMMING_F:
+    FillEllipse(round(PoolX1+PoolSX-SwimmerRad-(PoolSX-2*SwimmerRad)/50.0*Pos),
+                PoolY1+round((Team^.Number+0.5)*(PoolSY/4.0)),  SwimmerRad,SwimmerRad);
+   SWIMMING_B:
+    FillEllipse(round(PoolX1+SwimmerRad+(PoolSX-2*SwimmerRad)/50*(Pos - 50.0)),
+                PoolY1+round((Team^.Number+0.5)*(PoolSY/4.0)),  SwimmerRad,SwimmerRad)
+ end;
+end;
+
+Procedure CWorld.DrawTime(aTime:real);
+var
+ tt : real;
+begin
+  tt := aTime - trunc(aTime/60)*60.0;
+  PutImage(100,300,Numbers[trunc(aTime/600) mod 10].Data^,XORPut);
+  PutImage(100+Lwidth,300,Numbers[trunc(aTime/60) mod 10].Data^,XORPut);
+  PutImage(100+2*LWidth,300,Numbers[trunc(tT/10) mod 10].Data^,XORPut);
+  PutImage(100+3*LWidth,300,Numbers[trunc(tT) mod 10].Data^,XORPut);
+  PutImage(100+4*LWidth,300,Numbers[trunc(tT*10) mod 10].Data^,XORPut);
+  PutImage(100+5*LWidth,300,Numbers[round(tT*100) mod 10].Data^,XORPut);
+end;
+
+Procedure CWorld.DrawLeader;
+begin
+ SetFillStyle(SolidFill,Black);
+ Bar(400,273,640,349);
+ SetColor(LightGreen);
+ SetTextStyle(TriplexFont,HorizDir,2);
+ SetTextJustify(LeftText,TopText);
+ OutTextXY(400,273,AllRelay[LeadTeam]^.Swimmers[Leader]^.Name);
+ OutTextXY(400,303,AllRelay[LeadTeam]^.Name);
+end;
+
+Procedure CTeam.Draw;
+var
+ i : byte;
+begin
+  SetFillStyle(SolidFill,LightBlue);
+  Bar(PoolX1,PoolY1+round((Number+0.5)*PoolSY/4 - SwimmerRad*1.1),
+      PoolX1+PoolSX,PoolY1+round((Number+0.5)*PoolSY/4 + SwimmerRad*1.1));
+
+  SetFillStyle(SolidFill,Black);
+  Bar(PoolX1+PoolSX+21,PoolY1+Number    *PoolSY div 4+10,
+      PoolX1+PoolSX+40,PoolY1+(Number+1)*PoolSY div 4);
+  SetFillStyle(SolidFill,White);
+  Bar(PoolX1+PoolSX+5-SwimmerRad,PoolY1+round((Number+0.5)*(PoolSY/4.0))-SwimmerRad,
+      PoolX1+PoolSX+5+SwimmerRad,PoolY1+round((Number+0.5)*(PoolSY/4.0))+SwimmerRad);
+
+  for i := 1 to TeamSize do
+   Swimmers[i]^.Draw(i);
+end;
+
+Constructor CSwimmer.Init;          
+begin
+ Name := aName;
+ Number:= aNum;
+ Team := aT;
+ Speed   := 0;
+ Doing   := WAITING;
+ Pos     := 0;
+end;
+
+Procedure CSwimmer.Frame(aT:real);
+begin
+ Pos := Pos + Speed*aT;
+ if (Pos >= 50.0) and (Doing = SWIMMING_F) then
+ begin
+  Doing := SWIMMING_B;
+  Team^.Swimmers[Team^.NextNumber]^.Doing := SWIM_NEXT;
+ end;
+end;
+
+Procedure CSwimmer.Return;
+begin
+  Doing := DONE;
+  Pos := 0;
+end;
+
+Procedure CSwimmer.Swim;
+begin
+ Doing := SWIMMING_F;
+ Speed := V0 + random*(v1-v0);
+ Pos := 0;
+end;
+
+Constructor CTeam.Init(aW:PWorld;aName:string;aNum:word);
+var
+ j : byte;
+begin
+  Name := aName;
+  Number := aNum;
+  World := aW;
+  AllTime:=0;
+  ifDone := false;
+  TotalDist:=0;
+  NextNumber:= 1;
+  for j := 1 to TeamSize do 
+   begin
+    New(Swimmers[j],Init('',@self,j));
+    Swimmers[j]^.SetSpeed(5, 8);
+   end;
+end;
+
+Procedure CTeam.SwimNext;
+begin
+  if NextNumber > TeamSize then Exit;
+  Swimmers[NextNumber]^.Swim;
+  Inc(NextNumber);
+end;
+
+Procedure CWorld.FinishTeam(aNum:word);
+begin
+  Table[TPos] := aNum;
+  Inc(TPos);
+  if TPos = 5 then Play := false;
+end;
+
+Procedure CTeam.Frame(aTime:real);
+var
+ i : byte;
+begin
+  for i := 1 to TeamSize do if Swimmers[i]^.Doing in [SWIMMING_F,SWIMMING_B] then
+   begin
+    Swimmers[i]^.Frame(aTime);
+    MaxDist := Swimmers[i]^.Pos;
+    if MaxDist >= 100.0 then
+      begin
+        TotalDist := TotalDist + MaxDist;
+        if NextNumber <= TeamSize then
+          begin
+            Swimmers[i]^.Return;
+            SwimNext;
+          end
+        else
+         begin
+           Swimmers[i]^.Return;
+           AllTime := World^.Time;
+           ifDone := true;
+           World^.FinishTeam(Number);
+         end;
+      end;
+   end;
+   MaxDist := MaxDist + TotalDist;
+end;
+
+Procedure CSwimmer.SetSpeed;
+begin
+   V0:=aV0;v1:=aV1;
+end;
+
+Constructor CWorld.Init;
+var
+ grDriver: Integer;
+ grMode: Integer;
+ ErrCode: Integer;
+ i : byte;
+begin
+ grDriver := VGA;
+ grMode := VGAMed;
+ InitGraph(grDriver, grMode,' ');
+ ErrCode := GraphResult;
+ if ErrCode <> grOk then
+  begin
+   Writeln('Graphics error:', GraphErrorMsg(ErrCode));
+   Halt(1);
+  end;
+ InitLetters;
+ DrawPool;
+ TPos := 1;
+
+ for i := 0 to 3 do 
+   New(AllRelay[i],Init(@Self,'',i));
+
+ Allrelay[0]^.Name := 'Team RUS';
+ AllRelay[0]^.Swimmers[1]^.Name := 'Ivanov I';
+ AllRelay[0]^.Swimmers[2]^.Name := 'Petrov P';
+ AllRelay[0]^.Swimmers[3]^.Name := 'Sidorov A';
+ AllRelay[0]^.Swimmers[4]^.Name := 'Vatulin B';
+
+ Allrelay[1]^.Name := 'Team FRA';
+ AllRelay[1]^.Swimmers[1]^.Name := 'Jaquot J-M';
+ AllRelay[1]^.Swimmers[2]^.Name := 'Sevuit B';
+ AllRelay[1]^.Swimmers[3]^.Name := 'Beliniu S';
+ AllRelay[1]^.Swimmers[4]^.Name := 'Moneu G';
+
+ AllRelay[2]^.Name := 'Team GB';
+ AllRelay[2]^.Swimmers[1]^.Name := 'Johnson Jr';
+ AllRelay[2]^.Swimmers[2]^.Name := 'Smith B';
+ AllRelay[2]^.Swimmers[3]^.Name := 'Debian K';
+ AllRelay[2]^.Swimmers[4]^.Name := 'Vesson R';
+
+ Allrelay[3]^.Name := 'Team USA';
+ AllRelay[3]^.Swimmers[1]^.Name := 'Stivenson A';
+ AllRelay[3]^.Swimmers[2]^.Name := 'Brewing B';
+ AllRelay[3]^.Swimmers[3]^.Name := 'Robertini F';
+ AllRelay[3]^.Swimmers[4]^.Name := 'Stpanson L';
+
+ SetTextStyle(SansSerifFont,HorizDir,4);
+ SetTextJustify(CenterText,TopText);
+ SetColor(Green);
+ OutTextXY(100+LWidth*2-3,300-3,':');
+ OutTextXY(100+LWidth*4-2,300,'.');
+ SetTextStyle(SansSerifFont,HorizDir,2);
+ SetColor(Red);
+ SetTextJustify(RightText,TopText);
+ OutTextXY(190,275,'Time:');
+ OutTextXY(370,270,'Leader:');
+ OutTextXY(370,300,'Lead team:');
+
+ Randomize;
+
+ SetTextJustify(LeftText, Centertext);
+ SetTextStyle(DefaultFont,HorizDir,1);
+ OutTextXY(200,345,'Press any key to start');
+ for i := 0 to 3 do with AllRelay[i]^ do
+ begin
+  SetColor(Magenta);
+  OutTextXY(PoolX1+PoolSX+25,PoolY1+i*(PoolSY div 4)+5,Name);
+  Draw;
+ end;
+end;
+
+Procedure CWorld.Work;
+var
+ maxPos : Real;
+ i,j : byte;
+begin
+ lTime := 0;
+ DrawTime(lTime);
+ ReadKey;
+ SetFillStyle(SolidFill,Black);
+ Bar(200,340,400,349);
+ Play := true;
+
+ for i := 0 to 3 do Allrelay[i]^.SwimNext;
+
+ BegTick := Tick;
+ repeat
+   maxPos := 0;
+   Time := (Tick-BegTick) / 18.2;
+   for i := 0 to 3 do with AllRelay[i]^ do if not ifDone then
+   begin
+     Frame(Time-lTime);
+     if maxDist > maxPos then
+      begin
+       Leader:=NextNumber-1;
+       LeadTeam := i;
+       maxPos := maxDist;
+      end;
+   end;
+   SetColor(Green);
+   repeat until (Port[$03DA] and 8) <> 8;
+   repeat until (Port[$03DA] and 8) =  8;
+   for i := 0 to 3 do if not AllRelay[i]^.ifDone then
+     AllRelay[i]^.Draw;
+   repeat until (Port[$03DA] and 8) <> 8;
+   repeat until (Port[$03DA] and 8) =  8;
+   DrawLeader;
+   DrawTime(lTime);
+   DrawTime(Time);
+   lTime := Time;
+ until not play;
+
+ SetColor(LightRed);
+ SetFillStyle(SolidFill,Black);
+ Bar(100,130,400,220);
+ SetTextStyle(SansSerifFont,HorizDir,2);
+ SetTextJustify(RightText,TopText);
+ OutTextXY(250,130,'First place:');
+ OutTextXY(250,150,'Second place:');
+ OutTextXY(250,170,'Third place:');
+ OutTextXY(250,190,'Fourth place:');
+ SetTextJustify(LeftText,TopText);
+ SetColor(LightGreen);
+ OutTextXY(252,130,AllRelay[Table[1]]^.Name);
+ OutTextXY(252,150,AllRelay[Table[2]]^.Name);
+ OutTextXY(252,170,AllRelay[Table[3]]^.Name);
+ OutTextXY(252,190,AllRelay[Table[4]]^.Name);
+ ReadKey;
+ CloseGraph;
+End;
+
+var
+ Wrld : PWorld;
+begin
+  New(Wrld,Init);
+  Wrld^.Work;
+  Dispose(Wrld);
+end.

PAS/!SPbSTU/Boris/Graph/pool.pas

@@ -0,0 +1,358 @@
+uses Graph,CRT;
+
+CONST
+ TeamSize = 4;
+ PoolX1   = 30;
+ PoolY1   = 50;
+ PoolSX   = 500;
+ PoolSY   = 200;
+
+type
+ EDo = (WAITING, SWIMMING_F, SWIMMING_B, DONE);
+
+ TSwimmer = record
+  Name    : String[40];
+  Team    : Integer;
+  Number  : Integer;
+  Speed   : real;
+  V0,V1   : real;
+  Doing   : EDo;
+  Pos     : real;
+ end;
+
+ TTeam = record
+  Name      : string[30];
+  Number    : integer;
+  TotalDist : real;
+  Swimmers  : array [1..TeamSize] of TSwimmer;
+  NextNumber: integer;
+  ifBack    : boolean;
+  AllTime   : real;
+ end;
+
+ TLetter  = record
+  Width  : word;
+  Height : word;
+  Data   : pointer;
+  Size   : word;
+ end;
+var
+ Numbers   : array [0..9] of TLetter;
+ AllRelay  : array [0..3] of TTeam;
+ LWidth    : word;
+ LeadTeam,Leader : byte;
+ Time,LTime: real;
+ Tick      : longint Absolute $0040:$006c;
+ BegTick   : longint;
+
+Procedure DrawPool;
+var i,j : integer;
+begin
+  SetFillStyle(SolidFill,White);
+  Bar(PoolX1-20,PoolY1-20,PoolX1+PoolSX+20,PoolY1+PoolSY+20);
+  SetColor(LightGray);
+  Line(PoolX1-20,PoolY1-10,PoolX1+PoolSX+20,PoolY1-10);
+  Line(PoolX1-20,PoolY1+PoolSY+10,PoolX1+PoolSX+20,PoolY1+PoolSY+10);
+
+  Line(PoolX1-10,PoolY1-20,PoolX1-10,PoolY1+PoolSY+20);
+  Line(PoolX1+PoolSX+10,PoolY1-20,PoolX1+PoolSX+10,PoolY1+PoolSY+20);
+  for j := 1 to (PoolSX div 10)+1 do
+   begin
+    Line(PoolX1-10+j*10,PoolY1-20,PoolX1-10+j*10,PoolY1);
+    Line(PoolX1-10+j*10,PoolY1+PoolSY,PoolX1-10+j*10,PoolY1+PoolSY+20);
+   end;
+  for j := 1 to (PoolSY div 10)+1 do
+   begin
+    Line(PoolX1-20,PoolY1-10+j*10,PoolX1,PoolY1-10+j*10);
+    Line(PoolX1+PoolSX,PoolY1-10+j*10,PoolX1+PoolSX+20,PoolY1-10+j*10);
+   end;
+  SetFillStyle(SolidFill,LightBlue);
+  Bar(PoolX1,PoolY1,PoolX1+PoolSX,PoolY1+PoolSY);
+  for i := 1 to 3 do
+   for j := 1 to 24 do
+    begin
+     if odd(i+j) then SetFillStyle(SolidFill,Red) else SetFillStyle(SolidFill,White);
+     FillEllipse(PoolX1+j*(PoolSX div 25),PoolY1+i*(PoolSY div 4),3,3);
+    end;
+end;
+
+Procedure InitLetters;
+var
+ i   : integer;
+ pos : word;
+ s   : string[4];
+begin
+  SetTextStyle(SansSerifFont,HorizDir,4);
+  SetTextJustify(LeftText,TopText);
+  SetColor(Green);
+  LWidth := TextWidth('8');
+  s[0] := #1;
+  pos := 0;
+  for i := 0 to 9 do
+   begin
+     s[1] := chr(i+$30);
+     OutTextXY(pos,100,S);
+     with numbers[i] do
+      begin
+       Width := TextWidth(S);
+       Height := TextHeight(S);
+       Size := ImageSize(pos,100,pos+Width,100+Height);
+       GetMem(Data,Size);
+       GetImage(pos,100,pos+Width,100+Height,Data^);
+       inc(Pos,Width);
+      end;
+   end;
+   ClearDevice;
+end;
+
+CONST
+ SwimmerRad  = 4;
+
+Procedure DrawSwimmerOnWay(var aS : TSwimmer);
+begin
+  SetFillStyle(SolidFill,aS.Number+aS.Team);
+  if aS.Pos >= 50.0 then
+  FillEllipse(round(PoolX1+SwimmerRad+(PoolSX-2*SwimmerRad)/50*(aS.Pos - 50.0)),
+              PoolY1+round((aS.Team+0.5)*(PoolSY/4.0)),  SwimmerRad,SwimmerRad)
+  else FillEllipse(round(PoolX1+PoolSX-SwimmerRad-(PoolSX-2*SwimmerRad)/50.0*aS.Pos),
+              PoolY1+round((aS.Team+0.5)*(PoolSY/4.0)),  SwimmerRad,SwimmerRad);
+
+end;
+
+Procedure DrawSwimmerNext(var aS : TSwimmer);
+begin
+  SetFillStyle(SolidFill,aS.Number+aS.Team);
+  FillEllipse(PoolX1+PoolSX+5,PoolY1+round((aS.Team+0.5)*(PoolSY/4.0)),
+              SwimmerRad,SwimmerRad);
+end;
+
+Procedure DrawSwimmerOnWait(var aS : TSwimmer;aOrder:byte);
+begin
+  SetFillStyle(SolidFill,aS.Number+aS.Team);
+  FillEllipse(PoolX1+PoolSX+25,PoolY1+round((aS.Team+0.2)*PoolSY/4)+aOrder*8,
+              SwimmerRad,SwimmerRad);
+end;
+
+Procedure DrawTime(aTime:real);
+var
+ tt : real;
+begin
+  tt := aTime - trunc(aTime/60)*60.0;
+  PutImage(100,300,Numbers[trunc(aTime/600) mod 10].Data^,XORPut);
+  PutImage(100+Lwidth,300,Numbers[trunc(aTime/60) mod 10].Data^,XORPut);
+  PutImage(100+2*LWidth,300,Numbers[trunc(tT/10) mod 10].Data^,XORPut);
+  PutImage(100+3*LWidth,300,Numbers[trunc(tT) mod 10].Data^,XORPut);
+  PutImage(100+4*LWidth,300,Numbers[trunc(tT*10) mod 10].Data^,XORPut);
+  PutImage(100+5*LWidth,300,Numbers[round(tT*100) mod 10].Data^,XORPut);
+end;
+
+Procedure DrawLeader;
+begin
+ SetFillStyle(SolidFill,Black);
+ Bar(400,273,640,349);
+ SetColor(LightGreen);
+ SetTextStyle(TriplexFont,HorizDir,2);
+ SetTextJustify(LeftText,TopText);
+ OutTextXY(400,273,AllRelay[LeadTeam].Swimmers[Leader].Name);
+ OutTextXY(400,303,AllRelay[LeadTeam].Name);
+end;
+
+Procedure DrawTeam(var aT:TTeam);
+var
+ i : byte;
+begin
+  SetFillStyle(SolidFill,LightBlue);
+  Bar(PoolX1,PoolY1+round((aT.Number+0.5)*PoolSY/4 - SwimmerRad*1.1),
+      PoolX1+PoolSX,PoolY1+round((aT.Number+0.5)*PoolSY/4 + SwimmerRad*1.1));
+
+  SetFillStyle(SolidFill,Black);
+  Bar(PoolX1+PoolSX+21,PoolY1+aT.Number    *PoolSY div 4+10,
+      PoolX1+PoolSX+40,PoolY1+(aT.Number+1)*PoolSY div 4);
+  SetFillStyle(SolidFill,White);
+  Bar(PoolX1+PoolSX+5-SwimmerRad,PoolY1+round((aT.Number+0.5)*(PoolSY/4.0))-SwimmerRad,
+      PoolX1+PoolSX+5+SwimmerRad,PoolY1+round((aT.Number+0.5)*(PoolSY/4.0))+SwimmerRad);
+  for i := 1 to TeamSize do
+  begin
+   if aT.ifBack and (i=aT.NextNumber) then DrawSwimmerNext(aT.Swimmers[i])
+   else
+   case aT.Swimmers[i].Doing of
+    WAITING : DrawSwimmerOnWait(aT.Swimmers[i],i);
+    SWIMMING_F, SWIMMING_B : DrawSwimmerOnWay(aT.Swimmers[i]);
+   end;
+  end;
+end;
+
+var
+ maxPos : Real;
+ Table  : array [1..4] of Byte;
+ TPos   : word;
+ Play : boolean;
+ grDriver: Integer;
+ grMode: Integer;
+ ErrCode: Integer;
+ i,j : byte;
+begin
+ grDriver := VGA;
+ grMode := VGAMed;
+ InitGraph(grDriver, grMode,' ');
+ ErrCode := GraphResult;
+ if ErrCode <> grOk then
+  begin
+   Writeln('Graphics error:', GraphErrorMsg(ErrCode));
+   Halt(1);
+  end;
+ InitLetters;
+ DrawPool;
+ TPos := 1;
+ for i := 0 to 3 do with AllRelay[i] do
+  begin
+   Number    := i;
+   ifBack    := true;
+   NextNumber:= 1;
+   for j := 1 to TeamSize do with Swimmers[j] do
+    begin
+     Team    := i;
+     Number  := j;
+     Speed   := 0;
+     V0      := 5; V1 := 8;
+     Doing   := WAITING;
+     Pos     := 0;
+    end;
+   AllTime   := 0;
+   TotalDist := 0;
+  end;
+ Allrelay[0].Name := 'Team RUS';
+ AllRelay[0].Swimmers[1].Name := 'Ivanov I';
+ AllRelay[0].Swimmers[2].Name := 'Petrov P';
+ AllRelay[0].Swimmers[3].Name := 'Sidorov A';
+ AllRelay[0].Swimmers[4].Name := 'Vatulin B';
+
+ Allrelay[1].Name := 'Team FRA';
+ AllRelay[1].Swimmers[1].Name := 'Jaquot J-M';
+ AllRelay[1].Swimmers[2].Name := 'Sevuit B';
+ AllRelay[1].Swimmers[3].Name := 'Beliniu S';
+ AllRelay[1].Swimmers[4].Name := 'Moneu G';
+
+ AllRelay[2].Name := 'Team GB';
+ AllRelay[2].Swimmers[1].Name := 'Johnson Jr';
+ AllRelay[2].Swimmers[2].Name := 'Smith B';
+ AllRelay[2].Swimmers[3].Name := 'Debian K';
+ AllRelay[2].Swimmers[4].Name := 'Vesson R';
+
+ Allrelay[3].Name := 'Team USA';
+ AllRelay[3].Swimmers[1].Name := 'Stivenson A';
+ AllRelay[3].Swimmers[2].Name := 'Brewing B';
+ AllRelay[3].Swimmers[3].Name := 'Robertini F';
+ AllRelay[3].Swimmers[4].Name := 'Stpanson L';
+
+ SetTextStyle(SansSerifFont,HorizDir,4);
+ SetTextJustify(CenterText,TopText);
+ SetColor(Green);
+ OutTextXY(100+LWidth*2-3,300-3,':');
+ OutTextXY(100+LWidth*4-2,300,'.');
+ SetTextStyle(SansSerifFont,HorizDir,2);
+ SetColor(Red);
+ SetTextJustify(RightText,TopText);
+ OutTextXY(190,275,'Time:');
+ OutTextXY(370,270,'Leader:');
+ OutTextXY(370,300,'Lead team:');
+
+ Randomize;
+
+ SetTextJustify(LeftText, Centertext);
+ SetTextStyle(DefaultFont,HorizDir,1);
+ OutTextXY(200,345,'Press any key to start');
+ for i := 0 to 3 do with AllRelay[i] do
+ begin
+  SetColor(Magenta);
+  OutTextXY(PoolX1+PoolSX+25,PoolY1+i*(PoolSY div 4)+5,Name);
+  DrawTeam(AllRelay[i]);
+ end;
+ lTime := 0;
+ DrawTime(lTime);
+ ReadKey;
+ SetFillStyle(SolidFill,Black);
+ Bar(200,340,400,349);
+ Play := true;
+ for i := 0 to 3 do with AllRelay[i].Swimmers[1] do
+ begin
+   AllRelay[i].NextNumber := 2;
+   AllRelay[i].ifBack := false;
+   Doing := SWIMMING_F;
+   Speed := V0 + random*(v1-v0);
+ end;
+ BegTick := Tick;
+ repeat
+   maxPos := 0;
+   Time := (Tick-BegTick) / 18.2;
+   for i := 0 to 3 do with AllRelay[i] do
+      for j := 1 to TeamSize do With Swimmers[j] do
+         if (Doing = SWIMMING_F) or (Doing = SWIMMING_B) then
+          begin
+           if Pos+TotalDist > maxPos then
+            begin
+             Leader:=j;
+             LeadTeam := i;
+             maxPos := Swimmers[j].Pos+TotalDist;
+            end;
+            Pos := Pos + Speed*(Time-lTime);
+            if (Pos > 50.0) and (Doing = SWIMMING_F) then
+            begin
+             Doing := SWIMMING_B;
+             ifBack := true;
+            end;
+            if (Doing = SWIMMING_B) and (Pos>=100.0) then
+             begin
+              ifBack := false;
+              if NextNumber <= TeamSize then
+               begin
+                 Doing := DONE;
+                 TotalDist := TotalDist + Pos;
+                 with Swimmers[NextNumber] do
+                  begin
+                   Doing := SWIMMING_F;
+                   Speed := V0 + random*(v1-v0);
+                   Pos := 0;
+                  end;
+                 inc(NextNumber);
+               end
+              else
+               begin
+                Doing := DONE;
+                TotalDist := TotalDist + Pos;
+                AllTime := Time;
+                Table[TPos] := i;Inc(TPos);
+                if TPos=5 then Play :=  False;
+               end;
+             end;
+          end;
+   SetColor(Green);
+   repeat until (Port[$03DA] and 8) <> 8;
+   repeat until (Port[$03DA] and 8) =  8;
+   for i := 0 to 3 do if AllRelay[i].NextNumber <= (TeamSize+1) then
+     DrawTeam(AllRelay[i]);
+   repeat until (Port[$03DA] and 8) <> 8;
+   repeat until (Port[$03DA] and 8) =  8;
+   DrawLeader;
+   DrawTime(lTime);
+   DrawTime(Time);
+   lTime := Time;
+ until not play;
+ SetColor(LightRed);
+ SetFillStyle(SolidFill,Black);
+ Bar(100,130,400,220);
+ SetTextStyle(SansSerifFont,HorizDir,2);
+ SetTextJustify(RightText,TopText);
+ OutTextXY(250,130,'First place:');
+ OutTextXY(250,150,'Second place:');
+ OutTextXY(250,170,'Third place:');
+ OutTextXY(250,190,'Fourth place:');
+ SetTextJustify(LeftText,TopText);
+ SetColor(LightGreen);
+ OutTextXY(252,130,AllRelay[Table[1]].Name);
+ OutTextXY(252,150,AllRelay[Table[2]].Name);
+ OutTextXY(252,170,AllRelay[Table[3]].Name);
+ OutTextXY(252,190,AllRelay[Table[4]].Name);
+ ReadKey;
+ CloseGraph;
+end.

PAS/!SPbSTU/Boris/Kurs/KURS.PAS

@@ -0,0 +1,56 @@
+Uses KURSOVIK;
+
+var
+ Model  : ^CModel;
+ Buffer : PBuffer;
+ Device : PDevice;
+ Srcs   : PSource;
+ i :  longint;
+
+ BegVal,
+ LastVal : Real;
+ Steps   : integer;
+
+ BufferSize : integer;
+ S1,S2      : Real;
+
+ Delta, DovInt : real;
+
+begin
+ Randomize;
+Assign(output,'1.out');
+Rewrite(output);
+ Delta := 0.1;
+ DovInt := 1.64;
+
+ BegVal := 2.0;
+ LastVal := 13.0;
+
+ Steps := 20;
+
+ BufferSize := 3;
+ S1 := 2.0;
+ S2 := 3.0;
+
+ New(Buffer, Init(BufferSize));
+ New(Device, Init(BegVal));
+ New(Model, Init(2,Device,Buffer,Delta,DovInt));
+
+ New(Srcs,Init(1,S1));
+ Model^.AddNewSource(Srcs);
+ New(Srcs,Init(2,S2));
+ Model^.AddNewSource(Srcs);
+
+ for i := 0 to Steps do
+  begin
+   Device^.Lambda := BegVal + (LAstVal-BegVal)/Steps*i;
+   Model^.Start;
+   while Model^.Step do;
+   Model^.PrintValues;
+  end;
+
+ Close(OutPut);
+ Dispose(Model,Done);
+ Dispose(Buffer,Done);
+ Dispose(Device,Done);
+end.

PAS/!SPbSTU/Boris/Kurs/KURS2.PAS

@@ -0,0 +1,62 @@
+Uses KURSOVIK;
+
+var
+ Model  : ^CModel;
+ Buffer : PBuffer;
+ Device : PDevice;
+ Srcs1,Srcs2 : PSource;
+ i :  longint;
+
+ BegVal,
+ LastVal : Real;
+ Steps   : integer;
+
+ BufferSize : integer;
+ S1,S2,S3 : Real;
+
+ Delta, DovInt : real;
+
+begin
+ Randomize;
+Assign(output,'1.out');
+Rewrite(output);
+ Delta := 0.1;
+ DovInt := 1.64;
+
+ BegVal := 2.0;
+ LastVal := 3.0;
+
+ Steps := 20;
+
+ BufferSize := 3;
+ S1 := 2.0;
+ S2 := 3.0;
+
+ New(Buffer, Init(BufferSize));
+ New(Device, Init(BegVal));
+ New(Model, Init(2,Device,Buffer,Delta,DovInt));
+
+ New(Srcs1,Init(1,S1));
+ Model^.AddNewSource(Srcs1);
+ New(Srcs2,Init(2,S2));
+ Model^.AddNewSource(Srcs2);
+
+{ for i := 0 to Steps do
+  begin
+   Device^.Lambda := BegVal + (LAstVal-BegVal)/Steps*i;}
+   Model^.Start;
+   Model^.RealizSteps := 100000;
+   while Model^.Step do if Model^.Curstep mod 1000 = 6 then
+    begin
+     WriteLn('˜ £ - ',Model^.Curstep,
+         ' : P®âª2 = ',100*Srcs2^.RefusedReq/Srcs2^.TotalReq:0:2,
+         ' : P®âª1 = ',100*Srcs1^.RefusedReq/Srcs1^.TotalReq:0:2); 
+    end;
+{   Model^.PrintValues;
+  end;}
+
+ Close(OutPut);
+ Dispose(Model,Done);
+ Dispose(Buffer,Done);
+ Dispose(Device,Done);
+end.

PAS/!SPbSTU/Boris/Kurs/kursovik.pas

@@ -0,0 +1,496 @@
+unit Kursovik; 
+                            INTERFACE
+type       
+ PSource  = ^CSource; 
+ PDevice  = ^CDevice; 
+ PBuffer  = ^CBuffer; 
+
+{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
+
+TReq = record  
+  Birth : real; 
+  Death : real; 
+  FromSource : PSource; 
+  ToDevice   : PDevice; 
+end;
+{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
+
+
+{$R-}
+TReqArray = array [0..1000] of TReq;
+PReqArray = ^TReqArray;
+TSourceArr = array [0..1000] of PSource;
+PSourceArr = ^TSourceArr;
+PReq = ^TReq;
+{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
+
+
+ESOURCES = (SOURCE_DUMMY,SOURCE_EASIEST,SOURCE_ERLANG); {’¨¯ë ¨áâ®ç­¨ª®¢}
+
+CSource = object   
+  SType : ESOURCES; {Š ª®¢ ­ è ¨áâ®ç­¨ª? }
+  Name  : integer;  {€ ª ª ¥£® §®¢ãâ ?}
+
+  LastTime : real;  {‚à¥¬ï £¥­¥à æ¨¨ ¯®á«¥¤­¥£® § ¯à®á }
+  LastReq  : TReq;  {�®á«¥¤­¨© ᣥ­¥à¨à®¢ ­­ë© § ¯à®á}
+
+  NewTime  : real;  {Œ®¬¥­â £¥­¥à æ¨¨ ­®¢®£® § ¯à®á }
+  Lambda   : real;
+
+  TotalReq : longInt; {Ž¡é¥¥ ç¨á«® § ï¢®ª ®â ¨áâ®ç­¨ª }
+  DoneReq : longInt; {ç¨á«® ®¡à ¡®â ­­ëå § ï¢®ª ®â ¨áâ®ç­¨ª }  
+  RefusedReq:LongInt; {—¨á«® ®âª«®­¥­­ëå § ï¢®ª}
+  WaitTime : real; {Ž¡é¥¥ ¢à¥¬ï ¯à¥¡ë¢ ­¨ï ¢ á¨á⥬¥}
+  ProbRefuse:real; {‚¥à®ïâ­®áâì ®âª § } 
+  MatWait  : real; {Œ â¥¬ â¨ç¥áª®¥ ®¦¨¤ ­¨¥ ¢ ¡ãä¥à¥}
+
+  Constructor Init(aName : Integer;aLambda:real); {Š®­áâàãªâ®à á ¨¬¥­¥¬}
+  Procedure Reset; {‘¡à®á ¢á¥å áç¥â稪®¢}
+  Procedure GenNewReq; {ƒ¥­¥à æ¨ï ­®¢®£® § ¯à®á }
+  Destructor Done;virtual;
+end;{CSource}
+
+{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
+
+CDevice = object   {Ž¡ê¥ªâ - ¯à®á⥩襥 ãá⮩á⢮ ¬ áᮢ®£® ®¡á«ã¦¨¢ ­¨ï}
+  LastTime : real; {‚à¥¬ï ¯®á«¥¤­¥£® § ¢¥à襭¨ï ®¡á«ã¦¨¢ ­¨ï}
+
+  BegTime  : real; {‚à¥¬ï ­ ç «  ®¡á«ã¦¨¢ ­¨ï}
+  DoneTime : real; {‚६ï, ¢ ª®â®à®¥ § ª®­ç¨âáï ®¡à ¡®âª }
+
+  Stoppage : real; {Ž¡é¥¥ ¢à¥¬ï ¯à®áâ®ï ¯à¨¡®à }
+
+  IsWorking : boolean; {Žáãé¥á⢫ï¥âáï «¨ ®¡á«ã¦¨¢ ­¨¥ ?}
+  CurWorking : TReq; {’¥ªã騩 ®¡à ¡ â뢠¥¬ë© § ¯à®á}
+  Lambda   : real; 
+
+  Constructor Init(aLambda:real); {}
+  Function AddReq(aCurReq : PReq;aCurTime:real):boolean; {� ç «® ®¡à ¡®âª  § ¯à®á }
+  Procedure Reset; {‘¡à®á ãáâà-¢ }
+  Function DoneWork:PReq; {‡ ¢¥à襭¨¥ ®¡à ¡®âª¨ ⥪ã饣® § ¯à®á , á ¥£® ¢®§¢à â®¬}
+  Destructor Done;
+end; {CDevice}
+
+{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
+EBuffers = (BUFFER_DUMMY, BUFFER_FIFO, BUFFER_LIFO, BUFFER_PRIOR);
+
+CBuffer = object      {�ãää¥à § ¯à®á®¢}
+  BufType      : EBuffers; {’¨¯ ¡ãä¥à }
+  BufferLength : integer; {„«¨­  ¡ãä¥à }
+  CellCount    : integer; {ˆ­¤¥ªá ⥪ã饩 ᢮¡®¤­®© ï祩ª¨}
+  Data         : PReqArray; {‘®¡á⢥­­® á ¬ ¡ãä¥à}
+  Constructor Init(aBufLen:integer); {ˆ­¨æ¨ «¨§ æ¨ï ¡ãä¥à }
+  Destructor Done;virtual;{„¥áâàãªâ®à, ®­ ¨ ¥áâì}
+  Function SetBufferSize(aNewSize:integer):boolean;{ˆ§¬¥­¥­¨¥ à §¬¥à  ¡ãä¥à }
+  Procedure FreeBuffer; {Žá¢®¡®¦¤¥­¨¥ ¢á¥£® ¡ãä¥à  áà §ã}
+  Function AddReq(var aNew, rKicked:TReq):boolean; {„®¡ ¢«ï¥âáï § ¯à®á ¢ ¡ãä¥à.
+   …᫨ ¨§ ¡ãä¥à  ª ª®©-â® § ¯à®á 㤠«¥­, â® ä-æ¨ï ¢®§¢à. false, ¨ ¢ rKicked -
+   § ¯à®á, ª®â®àë© ®âª«®­¥­}
+  Function GetReq(var rReq:TReq):boolean;virtual; {‚ëâ é¨âì ¨§ ¡ãä¥à  § ¯à®á,
+        ¥á«¨ ãᯥ譮 - true}
+end; {CBuffer}
+{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
+
+CModel = object {� è  ¬®¤¥«ì ‘ŒŽ} 
+ Sources  : PSourceArr; {ˆáâ®ç­¨ª¨} 
+ SourceCnt: integer;    {—¨á«® ¨áâ®ç­¨ª®¢}
+ MaxSrc   : integer;    {� §¬¥à­®áâì ¬ áᨢ  ¨áâ®ç­¨ª®¢}
+
+ Buffer   : PBuffer;    {�ãä¥à}
+ Device   : PDevice;    {“áâனá⢮}
+
+ CurTime  : real;       {’¥ªã騩 ¬®¬¥­â ¢à¥¬¥­¨}
+ Delta    : real;
+ DovInt   : real;
+
+ NextSource:integer;    {Š ª®© ¨§ ¨áâ®ç­¨ª®¢ - ¡ëáâ॥}
+ RealizSteps:LongInt;   {�¥®¡å. ç¨á«® ॠ«¨§ æ¨©}
+ CurStep  : LongInt;    {’¥ªã騩 è £}
+{}
+ DoneCount,             {—¨á«® ®¡à ¡®â ­­ëå § ï¢®ª}
+ RefusedCount,           {—¨á«® ®âª«®­¥­­ëå § ï¢®ª}
+ TotalCount : integer;  {Ž¡é¥¥ ç¨á«® § ï¢®ª}
+
+ Working  : boolean;    {� ¡®â ¥â «¨ ¬®¤¥«ì ?}
+ WorkReq  : TReq;
+
+ Constructor Init(aBegSrcCnt:integer;aDev:PDevice;aBuf:PBuffer;
+                  aDel,aDov:Real);
+ Function SetSourceCount(aNewCnt:integer):boolean; {“áâ ­®¢ª  ­®¢®£® ç¨á« 
+                                              ¨áâ®ç­¨ª®¢, á á®åà ­¥­¨¥¬ áâ àëå}
+ Function AddNewSource(aNewSrc:PSource):boolean; {„®¡ ¢«¥­¨¥ ­®¢®£® ¨áâ®ç­¨ª }
+ Procedure SetNextSource; {� å®¤¨â NextSource}
+ Function TestVer:boolean; {}
+ Function RemoveSource(aName:integer):boolean; {“¤ «¥­¨¥ ¨áâ®ç­¨ª  ¨§ ¬®¤¥«¨}
+ Procedure Reset; {‘¡à®á ¢á¥å áç¥â稪®¢}
+ Procedure Start;
+ Procedure PrintValues;
+ Function Step:boolean; {Œ®¤¥«¨àã¥â á«¥¤ãî騩 è £, ¥á«¨ ¢ }
+ Destructor Done;
+end;
+{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
+                        IMPLEMENTATION
+
+Constructor CSource.Init(aName : Integer;aLambda:real);
+Begin
+  Name := aName;
+  SType := SOURCE_EASIEST;
+  Lambda := aLambda;
+  Reset;
+end;{CSource.Init}
+{-------------------------------------------------------------------------}
+Procedure CSource.Reset;
+Begin
+  LastTime :=0; NewTime:=0;
+  TotalReq :=0;
+  DoneReq :=0;
+  RefusedReq:=0;
+  WaitTime :=0;
+  ProbRefuse:=0;
+  MatWait  :=0;
+end;{CSource.Reset}
+{-------------------------------------------------------------------------}
+Procedure CSource.GenNewReq;
+Begin
+  LastTime := NewTime; 
+  NewTime := LastTime - Ln(Random)/Lambda;
+  Inc(TotalReq);
+  LastReq.Birth := NewTime;
+  LastReq.Death := -1.0;
+  LastReq.FromSource := @Self;
+end;{CSource.GenNewReq}
+{-------------------------------------------------------------------------}
+Destructor CSource.Done;
+begin
+end;
+{-------------------------------------------------------------------------}
+{    CDevice    }
+Constructor CDevice.Init(aLambda:real);
+begin
+  Lambda := aLambda;
+  Reset;
+end;{CDevice.Init}
+{=========================================}
+Procedure CDevice.Reset;
+begin
+  LastTime := 0;
+  DoneTime := 0;
+  Stoppage := 0;
+  IsWorking := false;
+end;{CDevice.Reset}
+{---------------------------}
+Function CDevice.AddReq(aCurReq : PReq;aCurTime:real):boolean; {� ç «® ®¡à ¡®âª  § ¯à®á }
+begin
+  AddReq := false;
+  if not isWorking then
+   begin
+    BegTime   := aCurTime;
+    Stoppage  := Stoppage + (BegTime-LastTime);
+    DoneTime  := BegTime - (Ln(Random) + Random)/Lambda;
+    IsWorking := true;
+    CurWorking := aCurReq^;
+    CurWorking.ToDevice := @Self;
+    AddReq    := true;      
+   end;
+end;{CDevice.AddReq}
+{=========================================}
+Function CDevice.DoneWork:PReq; 
+begin
+  DoneWork := nil;
+  if isWorking then   
+   begin
+     LastTime := DoneTime;
+     CurWorking.Death := DoneTime;
+     DoneWork := @CurWorking;
+     isWorking := false;
+   end;
+end;{CDevice.DoneWork}
+{=========================================}
+Destructor CDevice.Done;
+begin
+end;{CDevice.Done}
+{=========================================}
+
+{  CBuffer  } 
+Constructor CBuffer.Init(aBufLen:integer); 
+begin
+  BufType := BUFFER_PRIOR;
+  BufferLength := aBufLen;
+  CellCount := 0;
+  GetMem(Data,Sizeof(TReq)*BufferLength);
+  FillChar(Data^,Sizeof(TReq)*BufferLength,0);
+end;{CBuffer.Init}
+{-----------------------}
+Destructor CBuffer.Done;
+begin
+  FreeMem(Data,Sizeof(TReq)*BufferLength); {Dispose(data)}
+  BufferLength:=0;
+end;{CBuffer.Done}
+{-----------------------}
+Function CBuffer.SetBufferSize(aNewSize:integer):boolean;
+var
+ NewBuf : PReqArray;
+begin
+ SetBufferSize := false;
+ if aNewSize > BufferLength then
+  begin
+   GetMem(NewBuf,Sizeof(TReq)*aNewSize);
+   FillChar(NewBuf^,Sizeof(TReq)*aNewSize,0);
+   Move(Data^,NewBuf^,Sizeof(TReq)*BufferLength);
+   FreeMem(Data,Sizeof(TReq)*BufferLength);
+   Data := NewBuf;
+   BufferLength := aNewSize;
+   SetBufferSize := true;
+  end;
+end;{CBuffer.SetBufferSize}
+{-----------------------}
+Function CBuffer.AddReq(var aNew, rKicked:TReq):boolean;
+begin
+  if CellCount=BufferLength then {�  á ¬®¬ ¤¥«¥, â.ª á 0, â® ¡®«ìè¥}
+   begin
+     AddReq := false;
+     rKicked := aNew;
+     rKicked.Death := aNew.Birth; {‡ ¯à®á ®âª«®­¥­, ¢ ¬®¬¥­â, ª®£¤  ­®¢ë© ¯à¨¡ë«,
+                                    â.¥. ª®£¤  â®â ¡ë« ᮧ¤ ­}
+   end
+  else
+   begin
+     AddReq := true;
+     Data^[CellCount] := aNew;
+     Inc(CellCount);
+   end;
+end;{CBuffer.AddReq}
+{-----------------------}
+Function CBuffer.GetReq(var rReq:TReq):boolean;
+var 
+ i,n : byte;
+begin
+ GetReq := false;
+ if CellCount = 0 then Exit;
+ n := 0;
+ for i := 0 to CellCount-1 do if Data^[i].FromSource^.Name = 1 then
+  begin
+    n := i;
+    break;
+  end;
+
+ rReq := Data^[n];
+ Move(Data^[n+1],Data^[n],sizeof(TReq) * (CellCount-n-1));
+ Dec(CellCount);
+ GetReq := true;
+end;{CBuffer.GetReq}
+{---------------------------------------------}
+Procedure CBuffer.FreeBuffer;
+begin
+ CellCount := 0;
+end;
+{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
+
+Constructor CModel.Init(aBegSrcCnt:integer;aDev:PDevice;aBuf:PBuffer;
+                       aDel,aDov:Real);
+Begin
+  MaxSrc := aBegSrcCnt;
+  GetMem(Sources,Sizeof(PSource)*MaxSrc);
+  SourceCnt := 0;
+  RealizSteps := 100;
+  Buffer := aBuf;
+  Device := aDev;
+  Delta := aDel;
+  DovInt := aDov;
+  Reset;
+end;{CModel.Init}
+{---------------------------------------------------------}
+Procedure CModel.Reset;
+begin
+  NextSource:=0;
+  CurTime := 0;
+  CurStep := 0;
+  DoneCount := 0;
+  RefusedCount := 0;
+  RealizSteps := 100;
+  TotalCount := 0;
+  Working := false;
+end;{CModel.Reset}
+{------------------------------------------------------------------}
+Function CModel.SetSourceCount(aNewCnt:integer):boolean;
+var
+ NewBuf : PSourceArr;
+Begin
+ SetSourceCount := false;
+ if aNewCnt > MaxSrc then
+  begin
+   GetMem(NewBuf,Sizeof(PSource)*aNewCnt);
+   Move(Sources^,NewBuf^,Sizeof(PSource)*MaxSrc);
+   FreeMem(Sources,Sizeof(PSource)*MaxSrc);
+   Sources := NewBuf;
+   MaxSrc := aNewCnt;
+   SetSourceCount := true;
+  end;
+end;{CModel.SetSourceCount}
+{------------------------------------------------------------------}
+Function CModel.AddNewSource(aNewSrc:PSource):boolean;
+Begin
+  if SourceCnt >= MaxSrc then AddNewSource := SetSourceCount(MaxSrc+1);
+  Sources^[SourceCnt] := aNewSrc;
+  Inc(SourceCnt);
+end;{CModel.AddNewSource}
+{------------------------------------------------------------------}
+Function CModel.RemoveSource(aName:integer):boolean;
+var
+ c : integer;
+Begin
+  RemoveSource := false;
+  if SourceCnt = 1 then exit;  
+  for c := 0 to SourceCnt-1 do if Sources^[c]^.Name = aName then break;
+  if c = SourceCnt-1 then exit;
+  Dispose(Sources^[c],Done);
+  while c <> SourceCnt-1 do
+   begin
+    Sources^[c] := Sources^[c+1];
+    inc(c);
+   end;
+  Dec(SourceCnt);
+end;{CModel.RemoveSource}
+{------------------------------------------------------------------}
+Procedure CModel.SetNextSource; {� å®¤¨â NextSource}
+var
+ c      : integer;
+begin
+ NextSource := 0;
+ for c := 0 to SourceCnt-1 do
+ begin
+  if (Sources^[c]^.NewTime < Sources^[NextSource]^.NewTime) then
+   NextSource := c;
+ end;
+end;{CModel.SetNextSource}
+{------------------------------------------------------------------}
+Procedure CModel.Start;
+var
+ c,First : integer;
+begin
+ if (Device=nil) or (Buffer=nil) or (SourceCnt=0) then exit;
+ Reset;
+ Device^.Reset;
+ Buffer^.FreeBuffer;
+
+ First := 0;
+ for c := 0 to SourceCnt-1 do
+ begin
+  Sources^[c]^.Reset;
+  Sources^[c]^.GenNewReq;
+  if (Sources^[c]^.NewTime < Sources^[First]^.NewTime) then
+    First := c;
+ end;
+ WorkReq := Sources^[First]^.LastReq;
+ Device^.AddReq(@WorkReq,Sources^[First]^.NewTime);
+ Sources^[First]^.GenNewReq;
+
+ SetNextSource;
+
+ Working := true;
+end;
+{------------------------------------------------------------------}
+Function CModel.TestVer:boolean;
+var
+ NewV,c,p:real;
+ i : integer;
+begin
+ NewV:=0;
+ TestVer:=true;
+ for i := 0 to SourceCnt-1 do if Sources^[i]^.RefusedReq <> 0 then
+  begin
+   p := 1.0 * Sources^[i]^.RefusedReq / Sources^[i]^.TotalReq;
+   c := (DovInt*(1-p))/(Delta*Delta*p);
+   if c > NewV then NewV := c;
+  end;
+ if NewV > RealizSteps then
+  begin
+   RealizSteps := round(NewV);
+   TestVer := false;
+  end;
+end;{CModel.TextVer}
+{------------------------------------------------------------------}
+Function CModel.Step:boolean;
+var
+ Kicked : TReq;
+ i      : integer;
+ ret    : boolean;
+Begin
+ Step := false;
+ if Not Working then exit;
+ ret := false; {‘ç¨â ¥¬, çâ® ¯à®¤®«¦ âì ­¥ ¡ã¤¥¬}
+
+ for i:=0 to SourceCnt-1 do if Sources^[i]^.TotalReq < RealizSteps then
+   ret:=true;
+
+ if not ret then ret := not TestVer;
+  if Device^.DoneTime < Sources^[NextSource]^.NewTime then
+   begin
+    CurTime := Device^.DoneTime;
+    WorkReq := Device^.DoneWork^;
+    inc(DoneCount);
+    inc(TotalCount);
+    inc(WorkReq.FromSource^.DoneReq);
+
+    WorkReq.FromSource^.WaitTime := WorkReq.FromSource^.WaitTime +
+      WorkReq.Death - WorkReq.Birth;
+
+    if Buffer^.GetReq(WorkReq) then
+     begin {‚ ¡ãä¥à¥ ­ å®¤¨« áì § ï¢ª }
+       WorkReq.FromSource^.MatWait := WorkReq.FromSource^.MatWait +
+        CurTime-WorkReq.Birth;
+       Device^.AddReq(@WorkReq,CurTime);
+     end
+    else {Need to gen new req}
+     begin
+       Device^.AddReq(@Sources^[NextSource]^.LastReq,Sources^[NextSource]^.LastReq.Birth);
+       Sources^[NextSource]^.GenNewReq;
+       SetNextSource;
+     end;
+   end
+  else {�«¨¦ ©è¥¥ ᮡë⨥ - £¥­¥à æ¨ï § ¯à®á }
+   begin
+     CurTime := Sources^[NextSource]^.NewTime;
+     if not Buffer^.AddReq(Sources^[NextSource]^.LastReq,Kicked) then
+      begin
+        inc(Kicked.FromSource^.RefusedReq);
+
+        {Kicked.FromSource^.WaitTime := Kicked.FromSource^.WaitTime +
+         Kicked.Death-Kicked.Birth;}
+
+        Inc(RefusedCount);
+        Inc(TotalCount);
+      end;
+     Sources^[NextSource]^.GenNewReq;
+     SetNextSource;
+   end; {}
+ inc(CurStep);
+ Step := ret;
+end;{CModel.Step}
+{------------------------------------------------------------------}
+Procedure CModel.PrintValues;
+var
+ i : integer;
+begin
+  WriteLn('Žâ­. â®ç­®áâì - ',Delta*100:0:0,'%, ¤®¢. ¨­â ¢ ª¢. - ',DovInt:0:2);
+  WriteLn('• à-ª  ¯®â®ª  ¯à¨¡®à  - ', Device^.Lambda:0:2);
+  WriteLn('ˆáâ.|‚ᣠ§ ï¢.|Žâª § ï¢.|‚ë¯ § ï¢.|P ®âª.  |Œ â. ®¦ | Ž¡é. ¢à.');
+  for i := 0 to SourceCnt-1 do with Sources^[i]^ do
+  begin
+    write(Name:4,' ',TotalReq:9,' ',RefusedReq:9,' ',DoneReq:9,' ',100.0*RefusedReq/TotalReq:6:2,'%  ');
+    if DoneReq <> 0 then Write(MatWait/DoneReq:8:3,' ') else Write('  ---    ');
+    WriteLN(WaitTime:0:2);
+  end;
+  WriteLn('Š®íää¨æ¨¥­â ¯à®áâ®ï ¯à¨¡®à  - ',100*Device^.Stoppage/CurTime:0:2,'%');
+  WriteLN('---')
+end;{CModel.PrintValues}
+{------------------------------------------------------------------}
+Destructor CModel.Done;
+var
+ c : integer;
+Begin
+  for c:= 0 to SourceCnt-1 do Dispose(Sources^[c],Done);
+  FreeMem(Sources,Sizeof(PSource)*MaxSrc);
+end;{CModel.Done}
+{------------------------------------------------------------------}
+END. {EOF}

PAS/!SPbSTU/Bump/2dBump

@@ -0,0 +1,58 @@
+2D Bump (�ä䥪⠭¥à®¢­®© ¯®¢¥àå­®áâ¨). 
+c ”¥¤®à –믫 ª®¢
+
+
+‚® ¬­®£¨å ¤¥¬® ¨á¯®«ì§ã¥âáï íä䥪â 2D bump (2D ५ì¥ä ), ª®£¤  ¨áâ®ç­¨ª á¢¥â  (ç é¥ ¢á¥£® ®ªà㦭®áâì) ¤¢¨£ ¥âáï ¯® "५ì¥ä­®¬ã" íªà ­ã.
+
+‚®â ª ª íâ® ¤¥« ¥âáï:
+
+Žá¢¥é¥­­®áâì â®çª¨ § ¢¨á¨â ®â 㣫  ¬¥¦¤ã ­®à¬ «ìî ª ¦¤®£® ¯¨ªá¥« , ¨ ¨áâ®ç­¨ª®¬ ᢥâ .
+
+’ ª ª ª ¢¥ªâ®à ­®à¬ «¨ ¨¬¥¥â âਠª®®à¤¨­ âë (x,y,z), ¨ ¬ë §­ ¥¬ ª®®à¤¨­ âë x ¨ y, â® z ¢ëç¨á«ï¥âáï ¯® ä®à¬ã«¥ z=1-sqrt(x*x+y*y). …᫨ ­¥¯®­ïâ­®, ®âªã¤  ¢§ï« áì íâ  ä®à¬ã«  -- ¢ ¬ ¯®à  ¢á¯®¬­¨âì £¥®¬¥âà¨î ;) 
+
+’ ª ª ª ¢ ॠ«ì­®¬ ¢à¥¬¥­¨ íâ® ¡ã¤¥â ®ç¥­ì ¬¥¤«¥­­®, ⮠ᮧ¤ îâ § à ­¥¥ â ¡«¨æ㠯।¢ë¡®àª¨, £¤¥ ¤«ï ª ¦¤®£® X ¨ Y ¢ëç¨á«ï¥âáï §­ ç¥­¨¥ ¢¥ªâ®à  Z. �â  â ¡«¨æ  ­ §ë¢ ¥âáï enviroment map (ª àâ  ®ªà㦥­¨ï). �®¤®¡­ë¥ ª àâë ¨á¯®«ì§ãîâáï ¨ ¯à¨ ⥪áâãà¨à®¢ ­¨¨ "§¥àª «ì­ëå" ®¡ê¥ªâ®¢ (çâ® ­ ¬­®£® ¯à®é¥, 祬 ¯àﬠï âà áá¨à®¢ª  :) Ž¡ëç­® 墠⠥⠪ àâë à §¬¥à®¬ 256å256. ƒ¥­¥à¨âì ¥¥ ¬®¦­® ¨ á ¯®¬®éìî 1-sqrt(x^2+y^2), ¨ á ¯®¬®éìî ᨭãᮢ. ‚ ®¡é¥¬ á«ãç ¥ ¬®¦­® ¨á¯®«ì§®¢ âì «î¡ãî ¬®¤¥«ì ®á¢¥é¥­¨ï - ¢á¥ § ¢¨á¨â ®â ⮣®, çâ® ¢ë å®â¨â¥ ¯®«ãç¨âì :) .
+
+‚®â ¯à¨¬¥à ¯®áâ஥­¨ï ¯à®á⥩襩 ª àâë:
+
+   int i,j;float x,y;
+   int density=128; //à §¬¥à ¯ïâ­ 
+   int bright; //ª®«¨ç¥á⢮ ®â⥭ª®¢
+
+   for (i=0;i<256;i++){
+   for (j=0;j<256;j++){
+     x=j/density-1;// (¤¥« ¥âáï ¤«ï ⮣®, çâ®¡ë ¯à¨à¢¥á⨠ª®®à¤¨­ âë
+     y=i/density-1;//  ª §­ ç¥­¨ï¬ ®â -1 ¤® 1)
+     z=1-sqrt(x*x+y*y);
+     z=z<0?z:0;
+     envmap[i][j]=z*bright;}}
+
+
+’®çª  ­  íªà ­¥ ¤«ï ¢ë襯ਢ¥¤¥­­®£® á«ãç ï à ááç¨â뢠¥âáï ¯® ä®à¬ã«¥ result=envmap[X ­®à¬ «¨+density][Y ­®à¬ «¨+density] (â ª ª ª â®çª  ­ ¨¡®«ì襩 ®á¢¥é¥­­®á⨠«¥¦¨â ¯®á।¨­¥ ª àâë ®ªà㦥­¨ï) 
+
+�®à¬ «¨ X ¨ Y à ááç¨â뢠¥¬ â ª: 
+                                  xnorm=screen[x,y]-screen[x+n,y],
+                                  ynorm=screen[x,y]-screen[x,y+n].
+                                  
+ƒ¤¥ n - ç¨á«® ®â (-5 ¤® 5,n!=0) �®«ì訥 ç¨á«  ¯à¨¢®¤ïâ ª ᨫ쭮¬ã ãåã¤è¥­¨î ª à⨭ª¨. (€ ¬®¦¥â ¢ ¬ ¨ ­¥ ­ ¤® "¯à ¢¨«ì­®¥" ®â®¡à ¦¥­¨¥ ? ’®£¤  ¬®¦­® ¯à¨¬¥­ïâì ¨ ¡®«ì訥 ç¨á« ) � à ¬¥âà n ¢«¨ï¥â ­  "¢ëá®âã ५ì¥ä ". �¥ § ¡ã¤ìâ¥, çâ® ¯à¨ ®âà¨æ â¥«ì­ëå §­ ç¥­¨ïå n ५ì¥ä ¡ã¤¥â "¢¤ ¢«¥­­ë¬", ¯à¨ n>0 - ¢ë¯ãª«ë¬.)
+
+�â® ¢á¥ ª á ¥âáï ­¥¯®¤¢¨¦­®£® ¨áâ®ç­¨ª  á ª®®à¤¨­ â ¬¨ (0,0,-¡¥áª®­¥ç­®áâì) „«ï ⮣®, çâ®¡ë ¯ïâ­® á¢¥â  ¤¢¨£ «®áì, ­ã¦­® ¢á¥£® «¨èì ¨§ ¯®«ã稢襩áï ­®à¬ «¨ ¢ëç¥áâì à §­®áâì ª®®à¤¨­ â ¯¨ªá¥«  (®á¢¥é¥­­®áâì ª®â®à®£® à ááç¨â뢠¥âáï) ¨ ª®®à¤¨­ â ¨áâ®ç­¨ª  ᢥâ . Žª®­ç â¥«ì­ ï ®á¢¥é¥­­®áâì â®çª¨ ¯®«ãç ¥âáï â ª ï:
+
+   result=envmap[(xnorm-(lx-x))][(ynorm-(lx-y))]
+
+
+�®«ã稢襥áï §­ ç¥­¨¥ áà ¢­¨¢ ¥âáï á £à ­¨æ ¬¨ ¤®¯ãá⨬®£® ¤¨ ¯ §®­  ïમáâ¨, ¨ , ¥á«¨ ­ã¦­®, ¨á¯à ¢«ï¥âáï ¢ ᮮ⢥âá⢨¨ á í⮩ £à ­¨æ¥©.
+
+�ਬ¥à. 
+
+lx,ly - ª®®à¤¨­ âë ¨áâ®ç­¨ª  ᢥâ .
+x,y - ª®®à¤¨­ âë â®çª¨ ­  íªà ­¥ ¨ ­  ¡ ¬¯-⥪áâãà¥.
+b_low,b_max - ¬¨­¨¬ «ì­ë© ¨ ¬ ªá¨¬ «ì­ë© ¤®ãáâ¨¬ë© ¯®à®£ ®á¢¥é¥­­®á⨠â®çª¨. 
+   for (int y=0;y<200;y++){
+   for (int x=0;x<320;x++){
+   int xn=(bmap[x][y]-bmap[x+1][y])-(lx-x)+density;
+   int yn=(bmap[x][y]-bmap[x][y+1])-(ly-y)+density;
+   if (xnb_max) xn=b_low;
+   if (ynb_max) yn=b_max;
+   screen[x][y]=envmap[xn][yn];}}
+
+‚®â, ᮡá⢥­­®, ¨ ¢á¥. 

PAS/!SPbSTU/Bump/BUMP.PAS

@@ -0,0 +1,156 @@
+{$G+}
+{Innocenty Enikeew Copyright 2001}
+{�ணࠬ¬ -¤¥¬®­áâà æ¨ï  «£®à¨â¬  2d-bump mapping
+ (¨¬¨â æ¨ï ­¥à®¢­®© ¯®¢¥àå­®áâ¨) €«£®à¨â¬ ᯥàâ ®âªã¤ -â® ¨§ ¨­¥â  :) }
+const
+ bright  = 169; {‘¨«  ¨áâ®ç­¨ª  ᢥâ }
+ density = 128; {� ¤¨ãá ᢥ⮢®£® ¯ïâ­ }
+
+procedure SetMode(Mode:word);assembler; {“áâ ­®¢ª  £à ä. ०¨¬ . �¥§ ¯à®¢¥à®ª}
+asm
+  mov ax, Mode
+  int 10h
+end;{SetMode}
+{-------------------}
+Procedure CreatePalette;assembler; {‘®§¤ ­¨¥ ­ã¦­®© ¯ «¨âàë
+                                    256-梥⭮£® ०¨¬ }
+  asm
+    mov dx, 3c6h        {�®àâ ॣ¨áâà  ¬ áª¨ ¯ «¨âàë}
+    mov al, 0ffh        { FF - 0-256 -¢áï ¯ «¨âà }
+    out dx, al 		{We will change all palette}
+
+    mov dx, 3c8h        {�®àâ ¢ë¡®à  ­®¬¥à  æ¢¥â  ¤«ï § ¯¨á¨ ¢ ¯ «¨âàã}
+    mov al, 0
+    out dx, al		{Beginning from first}
+
+    mov cx, 128         {�â® ¡ã¤¥â ª®«-¢®¬ 梥⮢}
+    mov bx, 0           {’¥ªã騩 ¨­¤¥ªá}
+    inc dx		{Write pal port  -  3c9h }
+@@1:
+    mov al, bl          {R : 0-63}
+    push bx
+    push dx
+     mov bx, 3
+     div bx
+    pop dx
+    pop bx
+    out dx, al
+
+    mov al, bl		{G : 0-127}
+    shr al, 2
+    out dx, al
+
+(*    mov al, bl		{B : 0-255}
+    shr al, 8   *)
+    mov al, 10
+    out dx, al
+    inc bx
+    loop @@1
+
+    shr bx, 1
+    mov cx, 95
+@@2:
+    mov al, 0ffh          {R : 0-63}
+    shr al, 2
+    out dx, al
+
+    mov al, bl		{G : 0-127}
+    shr al, 1
+    out dx, al
+
+    mov al, bl		{B : 0-255}
+    shr al, 4
+    out dx, al
+    inc bx
+    loop @@2
+end;{CreatePalette}
+{-------------------------------}
+Function KeyPressed:boolean;assembler;
+asm
+  mov ah, 1
+  int 16h
+  mov al, 0
+  jz @@2
+  mov al, 1
+@@2:
+end;
+type
+ tEnv = array [0..250,0..250] of byte;
+ tScr = array [0..199,0..319] of byte;
+var
+ Inp             : FILE;
+ envmap          : ^TEnv;
+ bump,BackBuffer : ^tScr;
+ i,j,lx,ly       : integer;
+ nx,ny		 : integer;
+ dx,dy           : integer;
+ x,y,z           : real;
+
+Procedure Draw;
+begin
+ for i:=0 to 199 do
+  for j := 0 to 319 do
+   begin
+     nx := bump^[i,j] - bump^[i,j+1] - (lx-j) + density;
+     ny := bump^[i,j] - bump^[i+1,j] - (ly-i) + density;
+     if (nx>=255) or (nx<0) then nx := 255;
+     if (ny>=255) or (ny<0) then ny := 255;
+     BackBuffer^[i,j] := envmap^[ny,nx];
+   end;
+end;
+{-----------------------}
+Procedure DrawBack;assembler; {�à®à¨á®¢ª  ¡ãä¥à  ­  íªà ­}
+asm
+push es
+push ds
+  mov cx, 320*200
+  shr cx, 1
+  push 0A000h
+  pop es
+  xor di, di
+  lds si, BackBuffer
+  repe movsw
+pop ds
+pop es
+end;
+{-----------------------}
+begin
+ GetMem(bump,SizeOf(tScr));
+ GetMem(BackBuffer,SizeOf(tScr));
+ GetMem(EnvMap,256*256-1);
+ for i := 0 to 255 do
+  for j := 0 to 255 do
+   begin
+     x := j/density-1;
+     y := i/density-1;
+     z := 1 - sqrt(x*x+y*y);
+     if z < 0 then z:=0;
+     envmap^[i,j] := round(z*bright);
+   end;
+ Assign(Inp,'bump.dat');
+ Reset(inP,1);
+ BlockRead(Inp,Bump^,320*200);
+ Close(inp);
+ lx := 90;
+ ly := 100;
+ dx := 1;
+ dy := 1;
+ SetMode($13);
+ CreatePalette;
+
+ while not keypressed do
+ begin
+  Draw;
+  repeat until (Port[$03DA] and 8) <> 8;
+  repeat until (Port[$03DA] and 8) =  8;
+  DrawBack;
+  inc(lx,dx);
+  inc(ly,dy);
+  if (lx > 310) or (lx<5) then dx := -dx;
+  if (ly > 190) or (ly<5) then dy := -dy;
+ end;
+ SetMode(3);
+ FreeMem(bump,SizeOf(tScr));
+ freeMem(BackBuffer,SizeOf(tScr));
+ freeMem(EnvMap,256*256-1);
+end.

PAS/!SPbSTU/Bump/BUMP2.PAS

@@ -0,0 +1,155 @@
+{$G+}
+{Innocenty Enikeew Copyright 2001}
+{�ணࠬ¬ -¤¥¬®­áâà æ¨ï  «£®à¨â¬  2d-bump mapping
+ (¨¬¨â æ¨ï ­¥à®¢­®© ¯®¢¥àå­®áâ¨) €«£®à¨â¬ ᯥàâ ®âªã¤ -â® ¨§ ¨­¥â  :) }
+const
+ bright  = 253; {‘¨«  ¨áâ®ç­¨ª  ᢥâ }
+ density = 64; {� ¤¨ãá ᢥ⮢®£® ¯ïâ­ }
+
+procedure SetMode(Mode:word);assembler; {“áâ ­®¢ª  £à ä. ०¨¬ . �¥§ ¯à®¢¥à®ª}
+asm
+  mov ax, Mode
+  int 10h
+end;{SetMode}
+{-------------------}
+Procedure CreatePalette; {‘®§¤ ­¨¥ ­ã¦­®© ¯ «¨âàë
+                                    256-梥⭮£® ०¨¬ }
+var
+ R,G,B,i : byte;
+begin
+  asm
+    mov dx, 3c6h        {�®àâ ॣ¨áâà  ¬ áª¨ ¯ «¨âàë}
+    mov al, 0ffh        { FF - 0-256 -¢áï ¯ «¨âà }
+    out dx, al 		{We will change all palette}
+
+    mov dx, 3c8h        {�®àâ ¢ë¡®à  ­®¬¥à  æ¢¥â  ¤«ï § ¯¨á¨ ¢ ¯ «¨âàã}
+    mov al, 0
+    out dx, al		{Beginning from first}
+  end;
+  R:=0;G:=0;B:=0;
+  for i := 1 to 192 do
+  begin
+   R := i shr 2;
+   G := (i * 16) div 192;
+   asm
+     mov dx, 3C9h
+
+     mov al, R
+     out dx, al
+
+     mov al, G
+     out dx, al
+
+     mov al, B
+     out dx, al
+   end;
+  end;
+  for i := 1 to 64 do
+  begin
+   R := 48 + (i shr 2);
+   G := 16 + (i*48) shr 6;
+   asm
+     mov dx, 3C9h
+
+     mov al, R
+     out dx, al
+
+     mov al, G
+     out dx, al
+
+     mov al, B
+     out dx, al
+   end;
+  end;
+end;{CreatePalette}
+{-------------------------------}
+Function KeyPressed:boolean;assembler;
+asm
+  mov ah, 1
+  int 16h
+  mov al, 0
+  jz @@2
+  mov al, 1
+@@2:
+end;
+type
+ tEnv = array [0..250,0..250] of byte;
+ tScr = array [0..199,0..319] of byte;
+var
+ Inp             : FILE;
+ envmap          : ^TEnv;
+ bump,BackBuffer : ^tScr;
+ i,j,lx,ly       : integer;
+ nx,ny		 : integer;
+ dx,dy           : integer;
+ x,y,z           : real;
+
+Procedure Draw;
+begin
+ for i:=0 to 199 do
+  for j := 0 to 319 do
+   begin
+     nx := bump^[i,j] - bump^[i,j+1] - (lx-j) + density;
+     ny := bump^[i,j] - bump^[i+1,j] - (ly-i) + density;
+     if (nx>=255) or (nx<0) then nx := 255;
+     if (ny>=255) or (ny<0) then ny := 255;
+     BackBuffer^[i,j] := envmap^[ny,nx];
+   end;
+end;
+{-----------------------}
+Procedure DrawBack;assembler; {�à®à¨á®¢ª  ¡ãä¥à  ­  íªà ­}
+asm
+push es
+push ds
+  mov cx, 320*200
+  shr cx, 1
+  push 0A000h
+  pop es
+  xor di, di
+  lds si, BackBuffer
+  repe movsw
+pop ds
+pop es
+end;
+{-----------------------}
+begin
+ GetMem(bump,SizeOf(tScr));
+ GetMem(BackBuffer,SizeOf(tScr));
+ GetMem(EnvMap,256*256-1);
+ for i := 0 to 255 do
+  for j := 0 to 255 do
+   begin
+     x := j/density-1;
+     y := i/density-1;
+     z := 1 - sqrt(x*x+y*y);
+     if z < 0 then z:=0;
+     envmap^[i,j] := round(z*bright);
+   end;
+ Assign(Inp,'bump3.tga');
+ Reset(inP,1);
+ Seek(inP,$312);
+ BlockRead(Inp,Bump^,320*200);
+ Close(inp);
+ lx := 90;
+ ly := 100;
+ dx := 1;
+ dy := 1;
+ SetMode($13);
+ CreatePalette;
+
+ while not keypressed do
+ begin
+  Draw;
+  repeat until (Port[$03DA] and 8) <> 8;
+  repeat until (Port[$03DA] and 8) =  8;
+  DrawBack;
+  inc(lx,dx);
+  inc(ly,dy);
+  if (lx > 310) or (lx<5) then dx := -dx;
+  if (ly > 190) or (ly<5) then dy := -dy;
+ end;
+ SetMode(3);
+ FreeMem(bump,SizeOf(tScr));
+ freeMem(BackBuffer,SizeOf(tScr));
+ freeMem(EnvMap,256*256-1);
+end.

PAS/!SPbSTU/CUBE.OUT

@@ -0,0 +1,32 @@
+pos neg
+XYZ XYZ
+000 000 =  0 -  7030=0.78%
+
+000 001 =  1 - 14491=1.61%
+000 010 =  2 - 14289=1.59%
+000 100 =  4 - 14474=1.61%
+001 000 =  8 - 14179=1.58%
+010 000 = 16 - 14536=1.62%
+100 000 = 32 - 14483=1.61%
+
+000 011 =  3 - 28755=3.19%
+000 101 =  5 - 28790=3.20%
+000 110 =  6 - 28932=3.21%
+001 010 = 10 - 28492=3.17%
+001 100 = 12 - 28972=3.22%
+010 001 = 17 - 28638=3.18%
+010 100 = 20 - 28595=3.18%
+011 000 = 24 - 28687=3.19%
+100 001 = 33 - 28925=3.21%
+100 010 = 34 - 28779=3.20%
+101 000 = 40 - 29027=3.23%
+110 000 = 48 - 29170=3.24%
+
+000 111 =  7 - 57604=6.40%
+001 110 = 14 - 57660=6.41%
+010 101 = 21 - 57234=6.36%
+011 100 = 28 - 57869=6.43%
+100 011 = 35 - 57565=6.40%
+101 010 = 42 - 57654=6.41%
+110 001 = 49 - 57624=6.40%
+111 000 = 56 - 57547=6.39%

PAS/!SPbSTU/CUBE.PAS

@@ -0,0 +1,56 @@
+const
+ TRYs = 900000;
+
+type
+ tVec = record
+  x,y,z : real;
+ end;
+
+var
+ Norms : array [1..6] of tVec;
+ Ds    : array [1..6] of real;
+ count : array [0..63] of word;
+ j     : longint;
+ P     : tVec;
+ val,i  : byte;
+
+begin
+ with norms[1] do begin x:=1;y:=0; z:= 0; end;
+ with norms[2] do begin x:=0;y:=1; z:= 0; end;
+ with norms[3] do begin x:=0;y:=0; z:= 1; end;
+ with norms[4] do begin x:=-1;y:=0; z:= 0; end;
+ with norms[5] do begin x:=0;y:=-1; z:= 0; end;
+ with norms[6] do begin x:=0;y:=0; z:= -1; end;
+
+ for i := 1 to 6 do Ds[i] := -1.0;
+ Fillchar(Count,2*64,0);
+ randomize;
+
+ for j := 0 to TRYs do begin
+ val := 0;
+
+ with p do begin
+  x := random * 10.0 - 5;
+  y := random * 10.0 - 5;
+  z := random * 10.0 - 5;
+ end;
+
+ for i := 1 to 6 do
+ begin
+   val := val shl 1;
+   if (Norms[i].x*p.x + Norms[i].y*p.y + Norms[i].z*p.z + ds[i]) > 0 then inc(val);
+ end;
+ inc(count[val]);
+ end;
+
+ Assign(output, 'cube.out');
+ rewrite(output);
+
+ for j := 0 to 63 do
+ begin
+  for i := 1 to 6 do Write( (j shr (6-i)) and 1);
+  Write(' = ',j:2);
+  WriteLn(' - ', count[j]:5,'=',count[j]/TRYs*100:0:2,'%');
+ end;
+ close(output);
+end.

PAS/!SPbSTU/CoolKey/COOLKEY.BAK

@@ -0,0 +1,155 @@
+{$G+}
+UNIT CoolKey; {“¤®¡­ ï,   £« ¢­®¥ ¡ëáâà ï à ¡®â  á ª« ¢¨ âãன.
+               �®«ì訥 ¢®§¬®¦­®áâ¨}
+               INTERFACE
+{$C FIXED PRELOAD PERMANENT}
+Uses Dos;
+{$F+,S-,W-}
+Type
+EScanCode = (SC_BUFFULL, SC_ESCAPE, SC_1, SC_2, SC_3, SC_4, SC_5 ,SC_6, SC_7,
+             SC_8, SC_9, SC_0, SC_MINUS, SC_EQUAL, SC_BACKSPACE, SC_TAB,
+             SC_Q,SC_W,SC_E,SC_R,SC_T,SC_Y,SC_U,SC_I,SC_O,SC_P,SC_RBR,SC_LBR,
+             SC_ENTER,SC_LCTRL,SC_A,SC_S,SC_D,SC_F,SC_G,SC_H,SC_J,SC_K,SC_L,
+             SC_SEMICOLON,SC_AMPERSAND,SC_TILDE,SC_LSHIFT,SC_BACKSLASH,
+             SC_Z,SC_X,SC_C,SC_V,SC_B,SC_N,SC_M,SC_COMMA,SC_PERIOD,SC_SLASH,
+             SC_RSHIFT,SC_GREY_MUL,SC_LALT,SC_SPACE,SC_CAPSLOCK,SC_F1,SC_F2,
+             SC_F3,SC_F4,SC_F5,SC_F6,SC_F7,SC_F8,SC_F9,SC_F10,SC_NUMLOCK,
+             SC_SCROLLLOCK,SC_PAD_HOME,SC_PAD_UP,SC_PAD_PGUP,SC_GRAY_SUB,
+             SC_PAD_LEFT,SC_PAD_5,SC_PAD_RIGHT,SC_GRAY_ADD,SC_PAD_END,
+             SC_PAD_DOWN,SC_PAD_PGDN,SC_PAD_INS,SC_PAD_DEL, {Primary over}
+
+             SC_SYSREQ,SC_NOTE1_F11,SC_L102,SC_F11,SC_F12,SC_NOTE1_F15,
+             SC_PA1,SC_LWin,SC_RWIN,SC_MENU,SC_5E,SC_5F,SC_60,SC_61,SC_62,
+             SC_F16,SC_F17,SC_F18,SC_F19,SC_F20,SC_F21,SC_F22,SC_F23,SC_F24,
+             SC_6C,SC_ERASEOEF,SC_6E,SC_COPYPLAY,SC_70,SC_71,SC_CrSel,SC_DELTA,
+             SC_EXSEL,SC_75,SC_CLEAR,SC_77,SC_78,SC_79,SC_7A,SC_7B,SC_7C,SC_7D,
+             SC_7E,SC_7F,
+             {ADDITION TO TABLE, prefixed by 0E0h }
+SC_80,SC_81,SC_82,SC_83,SC_84,SC_85,SC_86,SC_87,SC_88,SC_89,SC_8A,SC_8B,SC_8C,SC_8D,SC_8E,SC_8F,
+SC_90,SC_91,SC_92,SC_93,SC_94,SC_95,SC_96,SC_97,SC_98,SC_99,SC_9A,SC_9B,SC_PAD_ENTER,SC_RCTRL,SC_9E,SC_9F,
+SC_A0,SC_A1,SC_A2,SC_A3,SC_A4,SC_A5,SC_A6,SC_A7,SC_A8,SC_A9,SC_PREFIX,SC_AB,SC_AC,SC_AD,SC_AE,SC_AF,
+SC_B0,SC_B1,SC_B2,SC_B3,SC_B4,SC_PAD_DIV,SC_B6,SC_PRINTSCREEN,SC_RALT,SC_B9,SC_BA,SC_BB,SC_BC,SC_BD,SC_BE,SC_BF,
+SC_C0,SC_C1,SC_C2,SC_C3,SC_C4,SC_C5,SC_C6,SC_HOME,SC_UP,SC_PGUP,SC_CA,SC_LEFT,SC_CC,SC_RIGHT,SC_CE,SC_END,
+SC_DOWN,SC_PGDN,SC_INSERT,SC_DELETE,SC_D4,SC_D5,SC_D6,SC_D7,SC_D8,SC_D9,SC_DA,SC_DB,SC_DC,SC_DD,SC_DE,SC_DF,
+SC_E0,SC_E1,SC_E2,SC_E3,SC_E4,SC_E5,SC_E6,SC_E7,SC_E8,SC_E9,SC_EA,SC_EB,SC_EC,SC_ED,SC_EE,SC_EF,
+SC_F0,SC__F1,SC__F2,SC__F3,SC__F4,SC__F5,SC__F6,SC__F7,SC__F8,SC__F9,SC_FA,SC_FB,SC_FC,SC_FD,SC_FE,SC_FF);
+
+TKeyTable = array [EScanCode] of boolean;
+     PKeyTable = ^TKeyTable;  {ƒ« ¢­ë© ⨯ ¬®¤ã«ï, ¬ áᨢ ­ ¦ âëå ª­®¯®ª}
+
+CONST
+ SC_NAME : array [EScanCode] of string [15] =
+  ('','Escape','1','2','3','4','5','6','7','8','9','0','Substract',
+   'Equal','Backspace','Tab','Q','W','E','R','T','Y','U','I','O','P',
+   'Right Bracket','Left Bracket','Enter', 'Left Ctrl','A','S','D','F','G','H',
+   'J','K','L','Semicolon','Ampersand','Tilde','Left Shift','Back Slash','Z',
+   'X','C','V','B','N','M',
+   'Comma','Period','Slash','Right Shift','Grey *','Left Alt',
+   'SpaceBar','CapsLock','F1','F2','F3','F4','F5','F6','F7','F8','F9','F10',
+   'NumLock','ScrollLock','Pad Home','Pad Up','Pad PgUp','Gray -','Pad Left',
+   'Pad 5','Pad Right','Gray +','Pad End','Pad Down','Pad PgDn','Pad Ins',
+   'Pad Del','','','','F11','F12','','','Left Win','Right Win','Menu','5E','5F',
+   '60','61','62','63','64','65','66','67','68','69','6A','6B','6C','6D','6E',
+   '6F','70','71','72','73','74','75','76','77','78','79','7A','7B','7C','7D',
+   '7E','7F', {Full Original PC/XT Keyboard}
+   {Begining of 101-key}
+   '80','81','!','@','#','$','%','^','&','*','(',')','_','+','8E','8F','90','91',
+   '92','93','94','96','96','97','98','99','9A','9B','Pad Enter', 'Right Ctrl',
+   '9E','9F','A0','A1','A2','A3','A4','A5','A6','A7','A8','A9','Prefix','AB',
+   'AC','AD','AE','AF','B0','B1','B2','B3','B4','Pad Div','Prefix','Printscreen',
+   'Right Alt','B9','BA','BB','BC','BD','BE','BF','C0','C1','C2','C3','C4','C5',
+   'C6','Home','Up','PgUp','CA','Left','CC','Right','CE','End','Down','PgDn',
+   'Insert','Delete','D4','D5','D6','D7','D8','D9','DA','Left Win','Right Win',
+   'Menu','DE','DF','E0','E1','E2','E3','E4','E5','E6','E7','E8','E9','EA',
+   'EB','EC','ED','EE','EF','F0','F1','F2','F3','F4','F5','F6','F7','F8','F9',
+   'FA','FB','FC','FD','FE','FF');
+
+
+Function InitKeyboard : PKeyTable; {�¥à¥å¢ â INT09. ‚®§¢à. 㪠­  â ¡«¨æã}
+Procedure CloseKeyboard; {‚®§¢à â ¯à¥à뢠­¨ï. ‚ë室}
+
+                IMPLEMENTATION
+const
+ gInited  : boolean = false;
+ lastPref : byte = 0;
+
+var
+ KeyTable : TKeyTable;
+ OldINT09 : Pointer;
+
+
+Procedure NewInt09;far;assembler;
+asm
+   push ax
+   push bx
+   push si
+
+   xor bx, bx
+   xor ax, ax
+   in  al, 60h
+   cmp al, 0E0h
+   jz @@SETPREF
+
+   mov bl, al                   {Save real value}
+   and bl, 7Fh
+   add bl, lastPref             {Calculate table offset}
+   mov si, offset KeyTable      {Load table}
+   add si, bx                   {Add index}
+
+(*   test al, 80h                    {Get 7th bit of key (pressed/released}
+   jz @@PRESSED
+   mov byte ptr ds:[si], 0h     {set table value false}
+   mov lastPref, 0
+   jmp @@OUT
+
+@@PRESSED:
+   mov byte ptr ds:[si], 1h     {set table value true}
+   mov lastPref, 0
+   jmp @@OUT
+*)
+   shr al, 7
+   not al
+   mov ds:[si], al
+   mov lastPref, 0
+   jmp @@OUT
+
+@@SETPREF:
+   mov lastPref, 80h            {This equals offset of extended keys}
+
+@@OUT:
+   cli
+
+   in al, 61h           { Get value of keyboard control lines}
+   mov ah, al           {  save it                           }
+   or al, 80h           { set the "enable kbt" bit           }
+   out 61h, al          {  and write it out the contorl port }
+   xchg ah, al          { fetch the original value           }
+   out 61h, al          {  and write it back                 }
+
+   mov al, 20h          { Send End-Of-Interrupt signal       }
+   out 20h, al          {  to the 8259 Interrupt Controller  }
+   sti
+
+   pop si
+   pop bx
+   pop ax
+   iret
+end;{NewInt09}
+{-------------------------------}
+Function InitKeyboard : PKeyTable; {�¥à¥å¢ â INT09. ‚®§¢à. 㪠­  â ¡«¨æã}
+begin
+  if gInited then Exit;
+  FillChar(KeyTable,256,0); {Zeroes keys table}
+  GetIntVec($09,OldINT09);
+  SetIntVec($09,Addr(NewINT09));
+  gInited := true;
+  InitKeyBoard := @KeyTable;
+end;{Init keyboard}
+{------------------------}
+Procedure CloseKeyboard; {‚®§¢à â ¯à¥à뢠­¨ï. ‚ë室}
+begin
+ if not gInited then exit;
+ SetIntVec($09,OldInt09);
+ gInited := false;
+end;{CloseKeyboard}
+END.

PAS/!SPbSTU/CoolKey/CoolKey.pas

@@ -0,0 +1,156 @@
+{$G+}
+UNIT CoolKey; {“¤®¡­ ï,   £« ¢­®¥ ¡ëáâà ï à ¡®â  á ª« ¢¨ âãன.
+               �®«ì訥 ¢®§¬®¦­®áâ¨}
+               INTERFACE
+{$C FIXED PRELOAD PERMANENT}
+Uses Dos;
+{$F+,S-,W-}
+Type
+EScanCode = (SC_BUFFULL, SC_ESCAPE, SC_1, SC_2, SC_3, SC_4, SC_5 ,SC_6, SC_7,
+             SC_8, SC_9, SC_0, SC_MINUS, SC_EQUAL, SC_BACKSPACE, SC_TAB,
+             SC_Q,SC_W,SC_E,SC_R,SC_T,SC_Y,SC_U,SC_I,SC_O,SC_P,SC_RBR,SC_LBR,
+             SC_ENTER,SC_LCTRL,SC_A,SC_S,SC_D,SC_F,SC_G,SC_H,SC_J,SC_K,SC_L,
+             SC_SEMICOLON,SC_AMPERSAND,SC_TILDE,SC_LSHIFT,SC_BACKSLASH,
+             SC_Z,SC_X,SC_C,SC_V,SC_B,SC_N,SC_M,SC_COMMA,SC_PERIOD,SC_SLASH,
+             SC_RSHIFT,SC_GREY_MUL,SC_LALT,SC_SPACE,SC_CAPSLOCK,SC_F1,SC_F2,
+             SC_F3,SC_F4,SC_F5,SC_F6,SC_F7,SC_F8,SC_F9,SC_F10,SC_NUMLOCK,
+             SC_SCROLLLOCK,SC_PAD_HOME,SC_PAD_UP,SC_PAD_PGUP,SC_GRAY_SUB,
+             SC_PAD_LEFT,SC_PAD_5,SC_PAD_RIGHT,SC_GRAY_ADD,SC_PAD_END,
+             SC_PAD_DOWN,SC_PAD_PGDN,SC_PAD_INS,SC_PAD_DEL, {Primary over}
+
+             SC_SYSREQ,SC_NOTE1_F11,SC_L102,SC_F11,SC_F12,SC_NOTE1_F15,
+             SC_PA1,SC_LWin,SC_RWIN,SC_MENU,SC_5E,SC_5F,SC_60,SC_61,SC_62,
+             SC_F16,SC_F17,SC_F18,SC_F19,SC_F20,SC_F21,SC_F22,SC_F23,SC_F24,
+             SC_6C,SC_ERASEOEF,SC_6E,SC_COPYPLAY,SC_70,SC_71,SC_CrSel,SC_DELTA,
+             SC_EXSEL,SC_75,SC_CLEAR,SC_77,SC_78,SC_79,SC_7A,SC_7B,SC_7C,SC_7D,
+             SC_7E,SC_7F,
+             {ADDITION TO TABLE, prefixed by 0E0h }
+SC_80,SC_81,SC_82,SC_83,SC_84,SC_85,SC_86,SC_87,SC_88,SC_89,SC_8A,SC_8B,SC_8C,SC_8D,SC_8E,SC_8F,
+SC_90,SC_91,SC_92,SC_93,SC_94,SC_95,SC_96,SC_97,SC_98,SC_99,SC_9A,SC_9B,SC_PAD_ENTER,SC_RCTRL,SC_9E,SC_9F,
+SC_A0,SC_A1,SC_A2,SC_A3,SC_A4,SC_A5,SC_A6,SC_A7,SC_A8,SC_A9,SC_PREFIX,SC_AB,SC_AC,SC_AD,SC_AE,SC_AF,
+SC_B0,SC_B1,SC_B2,SC_B3,SC_B4,SC_PAD_DIV,SC_B6,SC_PRINTSCREEN,SC_RALT,SC_B9,SC_BA,SC_BB,SC_BC,SC_BD,SC_BE,SC_BF,
+SC_C0,SC_C1,SC_C2,SC_C3,SC_C4,SC_C5,SC_C6,SC_HOME,SC_UP,SC_PGUP,SC_CA,SC_LEFT,SC_CC,SC_RIGHT,SC_CE,SC_END,
+SC_DOWN,SC_PGDN,SC_INSERT,SC_DELETE,SC_D4,SC_D5,SC_D6,SC_D7,SC_D8,SC_D9,SC_DA,SC_DB,SC_DC,SC_DD,SC_DE,SC_DF,
+SC_E0,SC_E1,SC_E2,SC_E3,SC_E4,SC_E5,SC_E6,SC_E7,SC_E8,SC_E9,SC_EA,SC_EB,SC_EC,SC_ED,SC_EE,SC_EF,
+SC_F0,SC__F1,SC__F2,SC__F3,SC__F4,SC__F5,SC__F6,SC__F7,SC__F8,SC__F9,SC_FA,SC_FB,SC_FC,SC_FD,SC_FE,SC_FF);
+
+TKeyTable = array [EScanCode] of boolean;
+     PKeyTable = ^TKeyTable;  {ƒ« ¢­ë© ⨯ ¬®¤ã«ï, ¬ áᨢ ­ ¦ âëå ª­®¯®ª}
+
+CONST
+ SC_NAME : array [EScanCode] of string [15] =
+  ('','Escape','1','2','3','4','5','6','7','8','9','0','Substract',
+   'Equal','Backspace','Tab','Q','W','E','R','T','Y','U','I','O','P',
+   'Right Bracket','Left Bracket','Enter', 'Left Ctrl','A','S','D','F','G','H',
+   'J','K','L','Semicolon','Ampersand','Tilde','Left Shift','Back Slash','Z',
+   'X','C','V','B','N','M',
+   'Comma','Period','Slash','Right Shift','Grey *','Left Alt',
+   'SpaceBar','CapsLock','F1','F2','F3','F4','F5','F6','F7','F8','F9','F10',
+   'NumLock','ScrollLock','Pad Home','Pad Up','Pad PgUp','Gray -','Pad Left',
+   'Pad 5','Pad Right','Gray +','Pad End','Pad Down','Pad PgDn','Pad Ins',
+   'Pad Del','','','','F11','F12','','','Left Win','Right Win','Menu','5E','5F',
+   '60','61','62','63','64','65','66','67','68','69','6A','6B','6C','6D','6E',
+   '6F','70','71','72','73','74','75','76','77','78','79','7A','7B','7C','7D',
+   '7E','7F', {Full Original PC/XT Keyboard}
+   {Begining of 101-key}
+   '80','81','!','@','#','$','%','^','&','*','(',')','_','+','8E','8F','90','91',
+   '92','93','94','96','96','97','98','99','9A','9B','Pad Enter', 'Right Ctrl',
+   '9E','9F','A0','A1','A2','A3','A4','A5','A6','A7','A8','A9','Prefix','AB',
+   'AC','AD','AE','AF','B0','B1','B2','B3','B4','Pad Div','Prefix','Printscreen',
+   'Right Alt','B9','BA','BB','BC','BD','BE','BF','C0','C1','C2','C3','C4','C5',
+   'C6','Home','Up','PgUp','CA','Left','CC','Right','CE','End','Down','PgDn',
+   'Insert','Delete','D4','D5','D6','D7','D8','D9','DA','Left Win','Right Win',
+   'Menu','DE','DF','E0','E1','E2','E3','E4','E5','E6','E7','E8','E9','EA',
+   'EB','EC','ED','EE','EF','F0','F1','F2','F3','F4','F5','F6','F7','F8','F9',
+   'FA','FB','FC','FD','FE','FF');
+
+
+Function InitKeyboard : PKeyTable; {�¥à¥å¢ â INT09. ‚®§¢à. 㪠­  â ¡«¨æã}
+Procedure CloseKeyboard; {‚®§¢à â ¯à¥à뢠­¨ï. ‚ë室}
+
+                IMPLEMENTATION
+const
+ gInited  : boolean = false;
+ lastPref : byte = 0;
+
+var
+ KeyTable : TKeyTable;
+ OldINT09 : Pointer;
+
+
+Procedure NewInt09;far;assembler;
+asm
+   push ax
+   push bx
+   push si
+
+   xor bx, bx
+   xor ax, ax
+   in  al, 60h
+   cmp al, 0E0h
+   jz @@SETPREF
+
+   mov bl, al                   {Save real value}
+   and bl, 7Fh
+   add bl, lastPref             {Calculate table offset}
+   mov si, offset KeyTable      {Load table}
+   add si, bx                   {Add index}
+
+(*   test al, 80h                    {Get 7th bit of key (pressed/released}
+   jz @@PRESSED
+   mov byte ptr ds:[si], 0h     {set table value false}
+   mov lastPref, 0
+   jmp @@OUT
+
+@@PRESSED:
+   mov byte ptr ds:[si], 1h     {set table value true}
+   mov lastPref, 0
+   jmp @@OUT
+*)
+   shr al, 7
+   not al
+   and al, 1
+   mov ds:[si], al
+   mov lastPref, 0
+   jmp @@OUT
+
+@@SETPREF:
+   mov lastPref, 80h            {This equals offset of extended keys}
+
+@@OUT:
+   cli
+
+   in al, 61h           { Get value of keyboard control lines}
+   mov ah, al           {  save it                           }
+   or al, 80h           { set the "enable kbt" bit           }
+   out 61h, al          {  and write it out the contorl port }
+   xchg ah, al          { fetch the original value           }
+   out 61h, al          {  and write it back                 }
+
+   mov al, 20h          { Send End-Of-Interrupt signal       }
+   out 20h, al          {  to the 8259 Interrupt Controller  }
+   sti
+
+   pop si
+   pop bx
+   pop ax
+   iret
+end;{NewInt09}
+{-------------------------------}
+Function InitKeyboard : PKeyTable; {�¥à¥å¢ â INT09. ‚®§¢à. 㪠­  â ¡«¨æã}
+begin
+  if gInited then Exit;
+  FillChar(KeyTable,256,0); {Zeroes keys table}
+  GetIntVec($09,OldINT09);
+  SetIntVec($09,Addr(NewINT09));
+  gInited := true;
+  InitKeyBoard := @KeyTable;
+end;{Init keyboard}
+{------------------------}
+Procedure CloseKeyboard; {‚®§¢à â ¯à¥à뢠­¨ï. ‚ë室}
+begin
+ if not gInited then exit;
+ SetIntVec($09,OldInt09);
+ gInited := false;
+end;{CloseKeyboard}
+END.

PAS/!SPbSTU/CoolKey/TEST.BAK

@@ -0,0 +1,18 @@
+uses coolkey;
+var
+ KT : PKeyTable;
+ i  : EScanCode;
+begin
+ KT := InitKeyboard;
+
+ aSSIGN(oUTpUT,'cOOL.TXT');
+ rEWRITE(OUTpUT);
+ while not KT^[SC_ESCAPE] do
+ begin
+  WritelN;{(#13'                                                        '#13);}
+  for i := SC_BUFFULL to SC_FF do
+   if KT^[i] then Write('Cool ', SC_NAME[i],' ');
+ end;
+ cLOSE(oUTPUT);
+ CloseKeyboard;
+end.

PAS/!SPbSTU/CoolKey/TEST.PAS

@@ -0,0 +1,18 @@
+uses coolkey;
+var
+ KT : PKeyTable;
+ i  : EScanCode;
+begin
+ KT := InitKeyboard;
+
+ aSSIGN(oUTpUT,'cOOL.TXT');
+ rEWRITE(OUTpUT);
+ while not KT^[SC_ESCAPE] do
+ begin
+  WritelN;{(#13'                                                        '#13);}
+  for i := SC_BUFFULL to SC_FF do
+   if KT^[i] then Write('Cool ', SC_NAME[i],' ');
+ end;
+ cLOSE(oUTPUT);
+ CloseKeyboard;
+end.

PAS/!SPbSTU/EQuations.pas

@@ -0,0 +1,268 @@
+{
+ „®áâã¯­ë¥ ®¯¥à æ¨¨:
+  +-*/ - áâ ­¤ àâ­®
+  ^    - ¢®§¢¥¤¥­¨¥ ¢ á⥯¥­ì
+  «î¡ë¥ ᨬ¢®«ë - ¢®á¯à¨­¨¬ îâáï ª ª •
+}
+
+const
+ deyst  = ['+','-','*','/','^',')','('];
+
+type
+  pTree = ^tTree;
+  tTree = record
+   operand   : real;
+   operation : char;
+   left  : pTree;
+   right : pTree;
+  end;
+
+ stack = ^tstack;
+ tstack = record
+  t : pTree;
+  n : stack;
+ end;
+{------------------------------}
+Procedure CreateBranch(var aStack : stack;aCurOper : char);
+var
+ aN : pTree;
+ aL : stack;
+begin
+ if (aStack = nil) or
+    ((aStack^.n = nil) AND NOT (aCurOper IN ['~','c','s','l','t','o'])) then
+  begin
+   WriteLn('Error in operators');
+   Halt(255);
+  end;
+ New(aN);
+ with aN^ do
+  begin
+   operation := aCurOper;
+   Right:=aStack^.t;
+   aL := aStack;
+   aStack := aStack^.n;
+   Dispose(aL);
+   if not (aCurOper in ['~','c','s','l','t','o']) then
+    begin
+     Left :=aStack^.t;
+     aL:=aStack;
+     aStack := aStack^.n;
+     Dispose(aL);
+    end
+   else Left:=nil;
+   aL:=aStack;
+  end;
+ New(aStack);
+ aStack^.n := aL;
+ aStack^.t := aN;
+end;
+{------------------------------}
+function GetPrior(a:char):integer;
+begin
+  case a of
+   '(':GetPrior:=5;
+   ')':GetPrior:=5;
+   '~':GetPrior:=100;
+   '+':GetPrior:=10;
+   '-':GetPrior:=12;
+   '*':GetPrior:=20;
+   '/':GetPrior:=22;
+   '^':GetPrior:=30;
+   else begin
+         WriteLN('Sorry, undefined operation, ''',a,'''');
+        end;
+  end;
+end;
+{------------------------------}
+function GetToken(var aStr:string;var aPos:byte):string;
+var
+ ret:string;
+begin
+ ret:='';
+ while (aStr[aPos] = ' ') and (aPos <= ord(aStr[0])) do inc(aPos);
+ if aStr[aPos] in Deyst then
+ begin
+  ret := aStr[aPos];
+  inc(aPos)
+ end
+ else
+ if aStr[aPos] in ['0'..'9','.'] then
+  while (aStr[aPos] in ['0'..'9','.']) and (aPos <= ord(aStr[0])) do
+  begin
+   ret:=ret + aStr[aPos];
+   inc(aPos);
+  end
+ else
+ begin
+  ret := aStr[aPos];
+  inc(aPos);
+ end;
+ while (aStr[aPos] = ' ') and (aPos <= ord(aStr[0])) do inc(aPos);
+ GetToken:=ret;
+end;
+{------------------------------}
+Function CreateTree(aInp:string):pTree;
+var
+
+ operations : string;
+ token      : string;
+ opPos,sPos : byte;
+ LastOprtn  : Boolean;
+ retcode    : integer;
+ TreeStack  : stack;
+ NewEl      : stack;
+begin
+ sPos:=1;
+ operations[0] := #255;
+ LastOprtn := true;
+ TreeStack := nil;
+ opPos := 0;
+ while sPos <= ord(aInp[0]) do
+ begin
+  Token := GetToken(aInp,sPos);
+  if Token[1] in Deyst then
+  begin
+   if Token[1] = '-' then
+   begin
+    if (sPos=2) OR (aInp[sPos-2] = '(') then
+     begin
+      inc(opPos);
+      operations[opPos] := '~';
+      LastOprtn := true;
+     end;
+   end
+   else
+    begin
+   if Token[1] <> '(' then
+    if LastOprtn then
+     begin
+      WriteLn('Error in input: ',aInp);
+      WriteLn('Expected operation at position near ''',Copy(aInp,sPos-Length(Token),5),'''');
+      Halt(236);
+     end
+    else
+     while (opPos > 0) and (GetPrior(Token[1]) < GetPrior(operations[opPos])) do
+      begin
+       CreateBranch(TreeStack,operations[opPos]);
+       dec(opPos);
+      end;
+   if Token[1] <> ')' then
+    begin
+     inc(opPos);
+     operations[opPos] := Token[1];
+     LastOprtn := true;
+    end
+   else
+    Dec(opPos);
+  end
+  end
+  else
+   begin
+    if not LastOprtn then
+     begin
+      WriteLn('Error in input: ',aInp);
+      WriteLn('Expected operand at position near ''',Copy(aInp,sPos-Length(Token),5),'''');
+      Halt(236);
+     end;
+    New(NewEl);
+    NewEl^.n := TreeStack;
+    new(NewEl^.t);
+    with NewEl^.t^ do
+    begin
+     left:=nil;
+     right:=nil;
+     if Token[1] IN ['0'..'9','.'] then
+     begin
+      Val(Token,operand,retcode);
+      operation := ' ';
+     end
+     else
+      operation := 'x';
+
+     if retcode <> 0 then
+      begin
+       WriteLn('Error in input: ',aInp);
+       WriteLn('in position ',sPos-Length(Token));
+       Halt(255);
+      end;
+    end;
+    TreeStack := NewEl;
+    LastOprtn := False;
+   end;
+  end;
+
+  while opPos > 0 do
+   begin
+    CreateBranch(TreeStack,operations[opPos]);
+    dec(opPos);
+   end;
+ CreateTree := TreeStack^.t;
+ Dispose(TreeStack);   
+end;
+{------=-=-=-=--==-=-=-=--=--==--=}
+Procedure ToPostfix(aT:pTree;var aOut:string);
+var
+ aStr : string[13];
+begin
+ if aT = nil then exit;
+ ToPostfix(aT^.Left,aOut);
+ ToPostfix(aT^.Right,aOut);
+ if aT^.Operation = ' ' then
+  begin
+   Str(aT^.operand:0:1,aStr);
+   aOut:=aOut+aStr+' ';
+  end
+ else
+   aOut:=aOut+aT^.Operation+' ';  
+end;
+{-----------------------}
+Function aInb(a,b:real):real;
+begin
+ if a > 0 then
+  aInb:=Exp(b*Ln(a))
+ else
+  aInb:=0;
+end;
+{-----------------------}
+Function CalculateTree(aT: pTree; aX:real):real;
+begin
+ if aT=nil then exit;
+ Case aT^.Operation of
+   ' ': CalculateTree:=aT^.Operand;
+   'x': CalculateTree:=aX;
+   '~': CalculateTree:=-CalculateTree(aT^.Right,aX);
+   '+': CalculateTree:=CalculateTree(aT^.Left,aX) + CalculateTree(aT^.Right,aX);
+   '-': CalculateTree:=CalculateTree(aT^.Left,aX) - CalculateTree(aT^.Right,aX);
+   '*': CalculateTree:=CalculateTree(aT^.Left,aX) * CalculateTree(aT^.Right,aX);
+   '/': CalculateTree:=CalculateTree(aT^.Left,aX) / CalculateTree(aT^.Right,aX);
+   '^': CalculateTree:=aInb(CalculateTree(aT^.Left,aX),CalculateTree(aT^.Right,aX));
+ end;
+end;
+{-----------------------}
+Procedure DisposeTree(aT : pTree);
+begin
+  if aT <> nil then
+  Begin
+   DisposeTree(aT^.Left);
+   if aT^.Right <> nil then DisposeTree(aT^.Right);
+   Dispose(aT);
+  end;
+end;
+{-------}
+var
+ aIn : string;
+ aOut : string;
+ Tree :pTree;
+begin
+ aIn := '-3*(-x)';
+ aOut :='';
+ Tree := CreateTree(aIn);
+ ToPostfix(Tree,aOut);
+{ Assign(OutPut,'9.out');
+ Rewrite(OutPut);}
+ WriteLn('‚ëà ¦¥­¨¥: ',aIn);
+ WriteLn('‚ëà ¦¥­¨¥ ¢ ¯®áâ䨪á. ä®à¬¥: ',aOut);
+ WriteLn('�¥§ã«ìâ â: ',CalculateTree(Tree, 1):0:3 );
+ Close(output);
+ DisposeTree(Tree);
+end.

PAS/!SPbSTU/Graph/BG-gen.PAS

@@ -0,0 +1,78 @@
+Uses Graph;
+const
+ table :array [0..15] of byte  = (0,1,2,Yellow,Blue,5,6,7,8,9,10,Yellow,LightBlue,13,14,15);
+var
+ inp,outp : file;
+ p        : pointer;
+ Size     : Word;
+ i,j      : word;
+ x,y      : word;
+ val      : byte;
+ gD,gM    : Integer;
+begin
+ gD:=VGA;
+ gM:=VGAMed;
+
+ InitGraph(gD,gM,'');
+
+ Assign(outp,'BG2.dat');
+ ReWrite(outp,1);
+
+ Assign(inp,'BG.bmp');
+ Reset(inp,1);
+
+  Seek(INP,$12);
+  BlockRead(inp,x,4);
+  BlockRead(inp,y,4);
+  Seek(Inp,$76);
+  for i := 0 to y-1 do
+    for j := 0 to (x-1) shr 1 do
+     begin
+      BlockRead(INP,val,1);
+      PutPixel(j*2+1,479-i, table[val and $F]);
+      PutPixel(j*2,479-i,table[(val shr 4) and $F]);
+     end;
+  Close(INP);
+
+  Size := ImageSize(0,0,(x shr 1),(y shr 1)-1);
+
+  i:=4;
+  BlockWrite(OUTP,i,1);
+  GetMem(P,Size);
+  BlockWrite(OUTP,Size,2);
+  i:=0;
+  BlockWrite(OUTP,i,2);
+  BlockWrite(OUTP,i,2);
+  GetImage(0,0,(x shr 1)-1,(y shr 1)-1,P^);
+  BlockWrite(OUTP,P^,Size);
+
+  BlockWrite(OUTP,Size,2);
+  i:=x shr 1;
+  BlockWrite(OUTP,i,2);
+  i:=0;
+  BlockWrite(OUTP,i,2);
+  GetImage(x shr 1,0,x-1,(y shr 1)-1,P^);
+  BlockWrite(OUTP,P^,Size);
+
+  BlockWrite(OUTP,Size,2);
+  i:=0;
+  BlockWrite(OUTP,i,2);
+  i:=y shr 1;
+  BlockWrite(OUTP,i,2);
+  GetImage(0,y shr 1,(x shr 1)-1,y-1,P^);
+  BlockWrite(OUTP,P^,Size);
+
+  BlockWrite(OUTP,Size,2);
+  i:=x shr 1;
+  BlockWrite(OUTP,i,2);
+  i:=y shr 1;
+  BlockWrite(OUTP,i,2);
+  GetImage(x shr 1,y shr 1,x-1,y-1,P^);
+  BlockWrite(OUTP,P^,Size);
+
+  FreeMem(P,Size);
+  ReadLn;
+
+ CloseGraph;
+ Close(OUTP);
+end.