home *** CD-ROM | disk | FTP | other *** search
/ BBS 1 / BBS#1.iso / maximus / ublutils.arj / UBL2NC4 / UBL2NC4.PAS < prev   
Pascal/Delphi Source File  |  1993-08-07  |  3KB  |  121 lines
  1.          {è«¡óÑαΓ«α UBL-List ó ΓѽÑΣ«¡¡πε ñ¿αÑ¬Γ«α¿ε NC 4.0}
  2.  
  3.                        {  ubl2nc4  }
  4.                        {  ver. 1.2 }
  5.  
  6.               {  (c) è«»δ½«ó æ.Ç. ¿ε½∞ 1993   }
  7.                  { E-mail: cop@horus.msk.su }         
  8.  
  9. {
  10. éδ ¼«ªÑΓÑ «Γí½áú«ñáα¿Γ∞ »α«úαá¼¼¿ßΓá ºá íÑßß«¡¡« »α«óÑñÑ¡¡πε ¡«τ∞,
  11. ¡á»αáó¿ó ß¿¼ó«½¿τÑ߬«Ñ ñѡѪ¡«Ñ ó«º¡áúαáªñÑ¡¿Ñ »« áñαÑßπ:
  12. î«ß¬óá, π½.è¿α«ó«úαáñ߬á∩, 24, ¬«α» 4, ¬ó 7, è«»δ½«óπ æÑαúÑε Ç¡áΓ«½∞Ñó¿τπ
  13. »αÑñ∞∩ó¿ΓÑ½ε »áß»«αΓá ßÑα¿¿ XXVIII-î₧ N 550533
  14. }
  15.  
  16. type
  17.  
  18. DirEntry = record     { ºá»¿ß∞ ΓѽÑΣ«¡¡«⌐ ñ¿αÑ¬Γ«α¿¿ - óßÑú« 128 íá⌐Γ}
  19.    Name:     array [1..24] of byte;
  20.    Phone:    array [1..24] of byte;
  21.    Emul:     array [1..8] of byte;
  22.    Protocol: array [1..8] of byte;
  23.    Cmd :     array [1..14] of byte;
  24.    Script:   array [1..14] of byte;
  25.    Rest  :   array [1..36] of byte;  {«ßΓáΓ«¬ ºá»¿ß¿ ¡Ñ ó»«½¡Ñ ∩ßÑ¡}
  26. end;
  27.  
  28. const
  29.   cEmul    :array [1..8] of byte = ($60,$09,$00,$00,$08,$00,$00,$00);
  30.   cProtocol:array [1..8] of byte = ($01,$00,$00,$00,$26,$04,$f9,$01);
  31.   BS:char=chr(8);
  32.  
  33. var
  34.     DirFile : file of DirEntry;
  35.     Rec:DirEntry;
  36.     f: text;
  37.     istr:string[128];
  38.     i,j:integer;
  39.     tName:string[24];
  40.     tPhone:string[24];
  41.     city:integer;
  42.     Moscow:boolean;
  43.  
  44. procedure help;
  45. begin
  46.   writeln('è«¡óÑαΓÑα UBList ó ΓѽÑΣ«¡¡πε ñ¿αÑ¬Γ«α¿ε NC 4.0 term90.dir');
  47.   writeln('        (c) è«»δ½«ó æ.Ç. ¿ε½∞ 1993 ver 1.2');
  48.   writeln;
  49.   writeln('êß»«½∞º«óá¡¿Ñ: ubl2nc4 [ubl_file] [-m]');
  50.   writeln('Ä»µ¿∩ -m ¿ß»«½∞ºπÑΓß∩ ñ½∩ î«ß¬óδ');
  51. end;
  52.  
  53.  
  54. procedure init;
  55. var j:integer;
  56. begin
  57.   city:=0;
  58.   Moscow:=false;
  59.   with Rec do begin
  60.     for j:=1 to 24 do Name[j]:=0;
  61.     for j:=1 to 24 do Phone[j]:=0;
  62.     for j:=1 to 8  do Emul[j]:=cEmul[j];
  63.     for j:=1 to 8  do Protocol[j]:=cProtocol[j];
  64.     for j:=1 to 14 do Cmd[j]:=0;
  65.     for j:=1 to 14 do Script[j]:=0;
  66.     for j:=1 to 36 do Rest[j]:=0;
  67.   end
  68. end;
  69.  
  70.  
  71. begin
  72.   init;
  73.   if paramcount <1 then begin
  74.     help;
  75.     halt;
  76.   end;
  77.   if paramcount =2 then begin
  78.     if (paramstr(2) = '-m') or (paramstr(2) = '-M') then Moscow:=true
  79.     else begin
  80.       help;
  81.       halt;
  82.     end;
  83.   end;
  84.   {$I-}
  85.   Assign(f, paramstr(1));
  86.   Reset(f);
  87.   {$I+}
  88.   if (IOResult = 0) then begin
  89.     Assign(dirFile,'term90.dir');
  90.     rewrite(Dirfile);
  91.     i:=1;
  92.     while not eof(f) do begin
  93.       readln(f,istr);
  94.       if istr[3]=chr(254) then inc(city);
  95.       if (istr[1]= chr($b3)) and (istr[3] <> chr(254)) and (istr[3]<>' ') then begin
  96.         write(bs,bs,bs); write(i); inc(i);
  97.         tName :=chr(city) + Copy(istr,3,24);
  98.         tName[24]:=chr(0);
  99.         if Moscow and (city=1) then begin  {î«ß¬óá »Ñαóá∩ ó ß»¿ß¬Ñ}
  100.           tPhone:=Copy(istr,35,8);
  101.           tPhone[9]:=chr(0);
  102.         end
  103.         else begin
  104.            tPhone:=Copy(istr,31,12);
  105.           tPhone[13]:=chr(0)
  106.         end;
  107.         with Rec do begin
  108.           for j:=1 to 24 do Name[j]:=byte(tName[j]);
  109.           for j:=1 to 24 do Phone[j]:=byte(tPhone[j]);
  110.         end;
  111.         write(DirFile,Rec);
  112.       end; {if}
  113.     end; {while}
  114.   end; {if}
  115.   close(DirFile);
  116.   close(f);
  117.   writeln;
  118.   writeln('OK ');
  119. end.
  120.  
  121.