home *** CD-ROM | disk | FTP | other *** search
/ BBS 1 / BBS#1.iso / maximus / ublutils.arj / UBL2TM / UBL-2-TM.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-29  |  11KB  |  334 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.  
  100. {-------------------------------------------------------------------}
  101. procedure Logo;
  102. begin
  103.   WriteLn;
  104.   WriteLn('======================== FREE WARE ==============================');
  105.   WriteLn('UBL_V??.LST to TM.FON converter   ver.1.0          Ivan Sinelobov');
  106.   WriteLn;
  107.   WriteLn('Night Director BBS: +7(095)938-0081, 2400/MNP5, 21:00-09:00//24h');
  108.   WriteLn('FIDONET: 2:5020/33.2;  RELCOM: vano@comcp.msk.su');
  109.   WriteLn;
  110. end;
  111. {-------------------------------------------------------------------}
  112. procedure Usage;
  113. begin
  114.   WriteLn('Usage: ', ParamStr(0), ' UBL_file [/Sspeed] [/Ppassword] [/Ccode]');
  115.   WriteLn;
  116.   WriteLn('  UBL_file - UBLIST from MikDim s/h company ver.66 or later');
  117.   WriteLn('  speed    - maximum baud rate (speed) of your modem');
  118.   WriteLn('  password - password to use at all BBS');
  119.   WriteLn('  code     - phone number of your city (095 for Moscow, Russia)');
  120.   WriteLn;
  121.   WriteLn('Example: ', ParamStr(0), ' ubl_v66.lst /S2400 /Pmypass /C095-');
  122.   WriteLn;
  123.   Halt(1);
  124. end;
  125. {-------------------------------------------------------------------}
  126. procedure Error;
  127. begin
  128.   WriteLn;
  129.   WriteLn(chr(7), chr(7), '*** Error in command line ***');
  130.   WriteLn;
  131. end;
  132. {-------------------------------------------------------------------}
  133. procedure NotFound;
  134. begin
  135.   WriteLn;
  136.   WriteLn(chr(7), chr(7), '*** Can''t open file ***');
  137.   WriteLn;
  138. end;
  139. {-------------------------------------------------------------------}
  140. function space(num : byte) : string;
  141. var
  142.    i : byte;
  143.    res : string[255];
  144. begin
  145.   res := '';
  146.   for num:=1 to num do
  147.      res := res + ' ';
  148.   space := res;
  149. end;
  150. {-------------------------------------------------------------------}
  151. function AddBlankLeft(s : string; len : byte) : string;
  152. begin
  153.   AddBlankLeft := space(len - Length(s)) + s;
  154. end;
  155. {-------------------------------------------------------------------}
  156. function AddBlankRight(s : string; len : byte) : string;
  157. begin
  158.   AddBlankRight := s + space(len - Length(s));
  159. end;
  160. {-------------------------------------------------------------------}
  161. procedure InitDialRec;
  162. begin
  163. with dial_tm do begin
  164.      name := space(30);      { name of remote system }
  165.      tstr := parm_pass;  { user password }
  166.      password := AddBlankRight(tstr, 15);
  167.      f1 := ' ';              { filler }
  168.      script := space(8);     { name script file }
  169.      f2 := ' ';
  170.      log := space(8);        { name of log file }
  171.      f3 := ' ';
  172.      phone := space(20);     { phone number }
  173.      f4 := ' ';
  174.      tstr := parm_speed+'N81';{ COM parameter e.g. 115200N81 }
  175.      para := AddBlankLeft(tstr, 9);
  176.      port := '0';            { COM Port 1-8, 0 means default COM port }
  177.      f5 := ' ';
  178.      total := space(5);      { Total number of connection }
  179.      f6 := space(2);
  180.      last := '..-..-..';     { Last log on date 'MM-DD-YY' }
  181.      f7 := ' ';
  182.      term := 'A';            { terminal (T)ty (A)nsi VT(5)2 VT(1)02 }
  183.      connectTo := 'M';       { Connect to (C)omputer (M)odem }
  184.      lineFeed := 'N';        { Add line feed (Y)es (N)o }
  185.      carriageReturn := 'Y';  { Add carriage return (Y)es (N)o }
  186.      localEcho := 'N';       { Local echo (Y)es (N)o }
  187.      wrap := 'Y';            { Auto wrap (Y)es (N)o }
  188.      destBs := 'Y';          { Destructive backspace (Y)es (N)o }
  189.      autoLog := 'N';         { Auto log session (Y)es (N)o }
  190.      longDistance := 'N';
  191.      stripHigh := 'N';
  192.      tagSeparator := 'N';
  193.      guessInitial := 'N';
  194.      reserved := space(2);   { reserved for future usage }
  195.      prefix := '1';          { Prefix 1-4 }
  196.      suffix := '1';          { Suffix 1-4 }
  197.      protocol := 'Z';        { Protocol XYZRBGSTMAC }
  198.      cr := chr(13);         { End of line CR and LF }
  199.      lf := chr(10);
  200. end;
  201. end;
  202. {-------------------------------------------------------------------}
  203. procedure FillOut;
  204. begin
  205. with dial_tm do begin
  206.      tstr := ubl_rec.BBS_name;         { name of remote system }
  207.      name := AddBlankRight(tstr, 30);
  208.      tstr := ubl_rec.phone;            { phone number }
  209.      if Pos(parm_code, tstr) = 1
  210.        then begin Found:= True; Delete(tstr, 1, Length(parm_code)); end;
  211.      phone := AddBlankRight(tstr, 20);
  212. end;
  213. end;
  214. {-------------------------------------------------------------------}
  215. procedure WriteOut;
  216. begin
  217.  
  218. with dial_tm do begin
  219.      Write(fout1, name);      { name of remote system }
  220.      Write(fout1, password);  { user password }
  221.      Write(fout1, f1);        { filler }
  222.      Write(fout1, script);    { name script file }
  223.      Write(fout1, f2);
  224.      Write(fout1, log);       { name of log file }
  225.      Write(fout1, f3);
  226.      Write(fout1, phone);     { phone number }
  227.      Write(fout1, f4);
  228.      Write(fout1, para);      { COM parameter e.g. 115200N81 }
  229.      Write(fout1, port);      { COM Port 1-8, 0 means default COM port }
  230.      Write(fout1, f5);
  231.      Write(fout1, total);     { Total number of connection }
  232.      Write(fout1, f6);
  233.      Write(fout1, last);      { Last log on date 'MM-DD-YY' }
  234.      Write(fout1, f7);
  235.      Write(fout1, term);      { terminal (T)ty (A)nsi VT(5)2 VT(1)02 }
  236.      Write(fout1, connectTo); { Connect to (C)omputer (M)odem }
  237.      Write(fout1, lineFeed);  { Add line feed (Y)es (N)o }
  238.      Write(fout1, carriageReturn);  { Add carriage return (Y)es (N)o }
  239.      Write(fout1, localEcho); { Local echo (Y)es (N)o }
  240.      Write(fout1, wrap);      { Auto wrap (Y)es (N)o }
  241.      Write(fout1, destBs);    { Destructive backspace (Y)es (N)o }
  242.      Write(fout1, autoLog);   { Auto log session (Y)es (N)o }
  243.      Write(fout1, longDistance);
  244.      Write(fout1, stripHigh);
  245.      Write(fout1, tagSeparator);
  246.      Write(fout1, guessInitial);
  247.      Write(fout1, reserved);  { reserved for future usage }
  248.      Write(fout1, prefix);    { Prefix 1-4 }
  249.      Write(fout1, suffix);    { Suffix 1-4 }
  250.      Write(fout1, protocol);  { Protocol XYZRBGSTMAC }
  251.      WriteLn(fout1);          { End of line CR and LF }
  252. end;
  253. end;
  254. {-------------------------------------------------------------------}
  255. procedure InitBuf;
  256. begin
  257.    for i:=0 to 255 do buffer[i] := ' ';
  258. end;
  259. {-------------------------------------------------------------------}
  260. begin
  261. Logo;
  262. if ParamCount < 1 then Usage;
  263.  
  264. parm_pass := space(15);
  265. parm_speed := '1200';
  266. parm_code := '000-';
  267. Found := False;
  268.  
  269. for i:=2 to ParamCount do
  270.   begin
  271.    tstr := ParamStr(i);
  272.    if tstr[1] = '/' then
  273.       case tstr[2] of
  274.         'c', 'C': begin Delete(tstr, 1, 2); parm_code := tstr; end;
  275.         'p', 'P': begin Delete(tstr, 1, 2); parm_pass := tstr; end;
  276.         's', 'S': begin Delete(tstr, 1, 2); parm_speed:= tstr; end;
  277.         else begin Error; Usage; Halt(1) end;
  278.       end
  279.    else begin Error; Usage; Halt(1) end;
  280.   end;
  281.  
  282. Assign(fin, ParamStr(1));
  283. {$I-} ReSet(fin); {$I+}
  284. if IOResult <> 0 then begin NotFound; Halt(1) end;
  285.  
  286. Assign(fout1, 'TM.FON');
  287. ReWrite(fout1);
  288.  
  289. Assign(fout2, 'TM.MEM');
  290. ReWrite(fout2);
  291.  
  292. {skip up to '├'}
  293. repeat
  294.    InitBuf;
  295.    ReadLn(fin, buffer);
  296. until eof(fin) or (ubl_rec.tag = '├');
  297.  
  298. line := 0;
  299.  
  300. {loop}
  301. repeat
  302.   for i:=0 to 255 do buffer[i] := chr(0);
  303.   ReadLn(fin, buffer);
  304.   Inc(line);
  305.   with ubl_rec do
  306.   begin
  307.    InitDialRec;
  308.    if (tag = '│') or (tag = '>') then
  309.       begin
  310.         Write(BBS_name, '                              ', chr(13));
  311.         FillOut;
  312.         WriteOut;
  313.         WriteLn(fout2, line, ':', weekday_time, '/', weekend_time, ' ', SysOp);
  314.       end
  315.    else
  316.         WriteOut;
  317.   end; {with ubl_rec}
  318. until eof(fin) or (ubl_rec.tag = '└');
  319.  
  320. Write('All done.                               ', chr(13));
  321.  
  322. close(fout1);
  323. close(fout2);
  324.  
  325. if Not Found then
  326.   begin
  327.     Write(chr(7), '*** Warning: Phone code "', parm_code, '" not found ***');
  328.   end;
  329.  
  330. WriteLn;
  331.  
  332. end.
  333. {-------------------------------------------------------------------}
  334.