home *** CD-ROM | disk | FTP | other *** search
/ BBS 1 / BBS#1.iso / communic / ubl-2-tm.arj / UBL-2-TM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-05-05  |  11.8 KB  |  355 lines
  1. program UBL_TM;
  2. { Date:  12-02-1992 }
  3. { Convert UBLIST to TM.FON and TM.MEM }
  4.  
  5. type
  6. {  Phone directory format for TeleMate 3.01 }
  7. DIAL_RECORD = record           { number of records = file length / FON_LEN }
  8.      name : string[30];        { name of remote system }
  9.      password : string[15];    { user password }
  10.      f1 : char;                { filler }
  11.      script : string[8];       { name script file }
  12.      f2 : char;
  13.      log : string[8];          { name of log file }
  14.      f3 : char;
  15.      phone : string[20];       { phone number }
  16.      f4 : char;
  17.      para : string[9];         { COM parameter e.g. "115200N81" }
  18.      port : char;              { COM Port '1'-'8', '0' use default (in TM.CFG) }
  19.      f5 : char;
  20.      total : string[5];        { Total number of connection }
  21.      f6 : string[2];
  22.      last : string[8];         { Last log on date "MM-DD-YY" }
  23.      f7 : char;
  24.      term : char;              { terminal (T)ty (A)nsi VT(5)2 VT(1)02 }
  25.      connectTo : char;         { Connect to (C)omputer (M)odem }
  26.      lineFeed : char;          { Add line feed (Y)es (N)o }
  27.      carriageReturn : char;    { Add carriage return (Y)es (N)o }
  28.      localEcho : char;         { Local echo (Y)es (N)o }
  29.      wrap : char;              { Auto wrap (Y)es (N)o }
  30.      destBs : char;            { Destructive backspace (Y)es (N)o }
  31.      autoLog : char;           { Auto log session (Y)es (N)o }
  32.      longDistance : char;      { Long distance (Y)es (N)o }
  33.      stripHigh : char;         { Strip high bit (Y)es (N)o }
  34.      tagSeparator : char;      { 0=space, 1=enter, 2=comma }
  35.      guessInitial : char;      { Use initial guessing (Y)es (N)o }
  36.      reserved : string[2];     { reserved for future usage }
  37.      prefix : char;            { Prefix 1-4 }
  38.      suffix : char;            { Suffix 1-4 }
  39.      protocol : char;          { Protocol XYZRBGSTMAC }
  40.      cr : char;                { End of line CR and LF}
  41.      lf : char;
  42. end;
  43.  
  44. (*
  45. } *dial_record[MAX_FON_SIZE];
  46.  
  47. char *dial_memo[MAX_FON_SIZE];
  48. *)
  49.  
  50. { format for UBLIST v.66 }
  51. UBL_RECORD = record
  52.      len : char;
  53.      tag : char;
  54.      f1 : char;
  55.      BBS_name : array [1..26] of char;
  56.      f2 : array [1..2] of char;
  57.      phone : array [1..12] of char;
  58.      f3 : array [1..3] of char;
  59.      speed : array [1..19] of char;
  60.      f4 : array [1..2] of char;
  61.      weekday_time : array [1..11] of char;
  62.      f5 : array [1..3] of char;
  63.      weekend_time : array [1..3] of char;
  64.      f6 : array [1..3] of char;
  65.      SysOp : array [1..19] of char;
  66.      f7 : array [1..2] of char;
  67.      address : array [1..11] of char;
  68.      f8 : char;
  69.      voice_phone : array [1..8] of char;
  70.      f9 : char;
  71.      cr : char;
  72.      lf : char;
  73. end;
  74. UBL_RECOR = record
  75.      len : char;
  76.      rcd : UBL_RECORD;
  77. end;
  78. const
  79.      MAX_FON_SIZE = 1000;
  80.      FON_LEN = 131;
  81.      MEMO_LEN = 30;
  82.      month : array [1..12] of string[3] =
  83.       ('jan', 'feb', 'mar', 'apr', 'may', 'jun', 'jul', 'aug', 'sep', 'oct', 'nov', 'dec');
  84.  
  85. var
  86.    buffer : string[255];
  87.    tstr   : string;
  88.    fin    : text;
  89.    fout1  : text; {file of DIAL_RECORD;}
  90.    fout2  : text;
  91.    ubl_rec   : UBL_RECORD absolute buffer;
  92.    dial_memo : string[MEMO_LEN];
  93.    dial_tm   : DIAL_RECORD;
  94.    parm_pass : string[15];
  95.    parm_speed: string[6];
  96.    parm_code : string[8];
  97.    i, line : integer;
  98.    Found : boolean;
  99.    Okhotin_Flag : boolean;
  100.  
  101. {-------------------------------------------------------------------}
  102. procedure Logo;
  103. begin
  104.   WriteLn('    ');
  105.   WriteLn('======================== FREE WARE ==============================');
  106.   WriteLn('UBL_V??.LST to TM.FON converter   ver.1.1          Ivan Sinelobov');
  107.   WriteLn;
  108.   WriteLn('Night Director BBS: +7(095) 938-0081, 2400/MNP5, 21:00-09:00//24h');
  109.   WriteLn('Fidonet (2:5020/104)                   Relcom (vano@comcp.msk.su)');
  110.   WriteLn('=================================================================');
  111.   WriteLn;
  112. end;
  113. {-------------------------------------------------------------------}
  114. procedure Usage;
  115. begin
  116.   WriteLn('Usage: Ubl-2-Tm.Exe UBL_file [/Sspeed] [/Ppassword] [/Ccode] [/O]');
  117.   WriteLn;
  118.   WriteLn('  UBL_file - UBLIST ver.66 or later');
  119.   WriteLn('  speed    - maximum baud rate (speed) of your modem');
  120.   WriteLn('  password - password to use at all BBS''es');
  121.   WriteLn('  code     - phone number of your city (095 for Moscow, Russia)');
  122.   WriteLn('  /O       - include only your city BBS''es. Special for Nicholas Okhotin');
  123.   WriteLn;
  124.   WriteLn('Example: ', ParamStr(0), ' ubl_v66.lst /S2400 /Pmypass /C095-');
  125.   WriteLn;
  126.   Halt(1);
  127. end;
  128. {-------------------------------------------------------------------}
  129. procedure Error;
  130. begin
  131.   WriteLn;
  132.   WriteLn(chr(7), chr(7), '*** Error in command line ***');
  133.   WriteLn;
  134. end;
  135. {-------------------------------------------------------------------}
  136. procedure NotFound;
  137. begin
  138.   WriteLn;
  139.   WriteLn(chr(7), chr(7), '*** Can''t open file ***');
  140.   WriteLn;
  141. end;
  142. {-------------------------------------------------------------------}
  143. function space(num : byte) : string;
  144. var
  145.    i : byte;
  146.    res : string[255];
  147. begin
  148.   res := '';
  149.   for num:=1 to num do
  150.      res := res + ' ';
  151.   space := res;
  152. end;
  153. {-------------------------------------------------------------------}
  154. function AddBlankLeft(s : string; len : byte) : string;
  155. begin
  156.   AddBlankLeft := space(len - Length(s)) + s;
  157. end;
  158. {-------------------------------------------------------------------}
  159. function AddBlankRight(s : string; len : byte) : string;
  160. begin
  161.   AddBlankRight := s + space(len - Length(s));
  162. end;
  163. {-------------------------------------------------------------------}
  164. procedure InitDialRec;
  165. begin
  166. with dial_tm do begin
  167.      name := space(30);      { name of remote system }
  168.      tstr := parm_pass;  { user password }
  169.      password := AddBlankRight(tstr, 15);
  170.      f1 := ' ';              { filler }
  171.      script := space(8);     { name script file }
  172.      f2 := ' ';
  173.      log := space(8);        { name of log file }
  174.      f3 := ' ';
  175.      phone := space(20);     { phone number }
  176.      f4 := ' ';
  177.      tstr := parm_speed+'N81';{ COM parameter e.g. 115200N81 }
  178.      para := AddBlankLeft(tstr, 9);
  179.      port := '0';            { COM Port 1-8, 0 means default COM port }
  180.      f5 := ' ';
  181.      total := space(5);      { Total number of connection }
  182.      f6 := space(2);
  183.      last := '..-..-..';     { Last log on date 'MM-DD-YY' }
  184.      f7 := ' ';
  185.      term := 'A';            { terminal (T)ty (A)nsi VT(5)2 VT(1)02 }
  186.      connectTo := 'M';       { Connect to (C)omputer (M)odem }
  187.      lineFeed := 'N';        { Add line feed (Y)es (N)o }
  188.      carriageReturn := 'Y';  { Add carriage return (Y)es (N)o }
  189.      localEcho := 'N';       { Local echo (Y)es (N)o }
  190.      wrap := 'Y';            { Auto wrap (Y)es (N)o }
  191.      destBs := 'Y';          { Destructive backspace (Y)es (N)o }
  192.      autoLog := 'N';         { Auto log session (Y)es (N)o }
  193.      longDistance := 'N';
  194.      stripHigh := 'N';
  195.      tagSeparator := 'N';
  196.      guessInitial := 'N';
  197.      reserved := space(2);   { reserved for future usage }
  198.      prefix := '1';          { Prefix 1-4 }
  199.      suffix := '1';          { Suffix 1-4 }
  200.      protocol := 'Z';        { Protocol XYZRBGSTMAC }
  201.      cr := chr(13);         { End of line CR and LF }
  202.      lf := chr(10);
  203. end;
  204. end;
  205. {-------------------------------------------------------------------}
  206. procedure FillOut;
  207. begin
  208. with dial_tm do begin
  209.      tstr := ubl_rec.BBS_name;         { name of remote system }
  210.      name := AddBlankRight(tstr, 30);
  211.      tstr := ubl_rec.phone;            { phone number }
  212.      if Pos(parm_code, tstr) = 1
  213.        then begin Found:= True; Delete(tstr, 1, Length(parm_code)); end
  214.        else begin prefix:='2'; suffix:='2'; end;
  215.      phone := AddBlankRight(tstr, 20);
  216. end;
  217. end;
  218. {-------------------------------------------------------------------}
  219. procedure WriteOut;
  220. begin
  221.  
  222. with dial_tm do begin
  223.      Write(fout1, name);      { name of remote system }
  224.      Write(fout1, password);  { user password }
  225.      Write(fout1, f1);        { filler }
  226.      Write(fout1, script);    { name script file }
  227.      Write(fout1, f2);
  228.      Write(fout1, log);       { name of log file }
  229.      Write(fout1, f3);
  230.      Write(fout1, phone);     { phone number }
  231.      Write(fout1, f4);
  232.      Write(fout1, para);      { COM parameter e.g. 115200N81 }
  233.      Write(fout1, port);      { COM Port 1-8, 0 means default COM port }
  234.      Write(fout1, f5);
  235.      Write(fout1, total);     { Total number of connection }
  236.      Write(fout1, f6);
  237.      Write(fout1, last);      { Last log on date 'MM-DD-YY' }
  238.      Write(fout1, f7);
  239.      Write(fout1, term);      { terminal (T)ty (A)nsi VT(5)2 VT(1)02 }
  240.      Write(fout1, connectTo); { Connect to (C)omputer (M)odem }
  241.      Write(fout1, lineFeed);  { Add line feed (Y)es (N)o }
  242.      Write(fout1, carriageReturn);  { Add carriage return (Y)es (N)o }
  243.      Write(fout1, localEcho); { Local echo (Y)es (N)o }
  244.      Write(fout1, wrap);      { Auto wrap (Y)es (N)o }
  245.      Write(fout1, destBs);    { Destructive backspace (Y)es (N)o }
  246.      Write(fout1, autoLog);   { Auto log session (Y)es (N)o }
  247.      Write(fout1, longDistance);
  248.      Write(fout1, stripHigh);
  249.      Write(fout1, tagSeparator);
  250.      Write(fout1, guessInitial);
  251.      Write(fout1, reserved);  { reserved for future usage }
  252.      Write(fout1, prefix);    { Prefix 1-4 }
  253.      Write(fout1, suffix);    { Suffix 1-4 }
  254.      Write(fout1, protocol);  { Protocol XYZRBGSTMAC }
  255.      WriteLn(fout1);          { End of line CR and LF }
  256. end;
  257. end;
  258. {-------------------------------------------------------------------}
  259. procedure InitBuf;
  260. begin
  261.    for i:=0 to 255 do buffer[i] := ' ';
  262. end;
  263. {-------------------------------------------------------------------}
  264. begin
  265. Logo;
  266. if ParamCount < 1 then Usage;
  267.  
  268. parm_pass := space(15);
  269. parm_speed := '1200';
  270. parm_code := '000-';
  271. Found := False;
  272. Okhotin_Flag := False;
  273.  
  274. for i:=2 to ParamCount do
  275.   begin
  276.    tstr := ParamStr(i);
  277.    if tstr[1] = '/' then
  278.       case tstr[2] of
  279.         'c', 'C': begin Delete(tstr, 1, 2); parm_code := tstr; end;
  280.         'p', 'P': begin Delete(tstr, 1, 2); parm_pass := tstr; end;
  281.         's', 'S': begin Delete(tstr, 1, 2); parm_speed:= tstr; end;
  282.         'o', 'O': begin Okhotin_Flag := True; end;
  283.         else begin Error; Usage; Halt(1) end;
  284.       end
  285.    else begin Error; Usage; Halt(1) end;
  286.   end;
  287.  
  288. Assign(fin, ParamStr(1));
  289. {$I-} ReSet(fin); {$I+}
  290. if IOResult <> 0 then begin NotFound; Halt(1) end;
  291.  
  292. Assign(fout1, 'TM.FON');
  293. ReWrite(fout1);
  294.  
  295. Assign(fout2, 'TM.MEM');
  296. ReWrite(fout2);
  297.  
  298. {skip up to '├'}
  299. repeat
  300.    InitBuf;
  301.    ReadLn(fin, buffer);
  302. until eof(fin) or (ubl_rec.tag = '├');
  303.  
  304. line := 0;
  305.  
  306. {loop}
  307. repeat
  308.   for i:=0 to 255 do buffer[i] := chr(0);
  309.   ReadLn(fin, buffer);
  310.   Inc(line);
  311.   with ubl_rec do
  312.   begin
  313.    InitDialRec;
  314.    
  315.    if Okhotin_Flag then
  316.       if ((tag = '│') or (tag = '>')) and 
  317.          (Pos(parm_code, ubl_rec.phone) = 1) then
  318.          begin
  319.            Write(BBS_name, '                              ', chr(13));
  320.            FillOut;
  321.            WriteOut;
  322.            WriteLn(fout2, line, ':', weekday_time, '/', weekend_time, ' ', SysOp);
  323.          end
  324.       else begin 
  325.              Write('Don`t want -> Don`t call !                           ', chr(13)); 
  326.            end   
  327.    else   
  328.       if ((tag = '│') or (tag = '>')) then
  329.          begin
  330.            Write(BBS_name, '                              ', chr(13));
  331.            FillOut;
  332.            WriteOut;
  333.            WriteLn(fout2, line, ':', weekday_time, '/', weekend_time, ' ', SysOp);
  334.          end
  335.       else
  336.          WriteOut;
  337.       
  338.   end; {with ubl_rec}
  339. until eof(fin) or (ubl_rec.tag = '└');
  340.  
  341. Write('All done.                               ', chr(13));
  342.  
  343. close(fout1);
  344. close(fout2);
  345.  
  346. if Not Found then
  347.   begin
  348.     Write(chr(7), '*** Warning: Phone code "', parm_code, '" not found ***');
  349.   end;
  350.  
  351. WriteLn;
  352.  
  353. end.
  354. {-------------------------------------------------------------------}
  355.