home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / rbbs / cv.lzh / CV.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-20  |  6KB  |  254 lines
  1. Program Convert; { Program Code: Hostile }
  2. Uses CRT,DOS;
  3. Var
  4. { WWIV variables + a few RBBS ones }
  5.    Year,Mon,Day,DW, Hour, Min,Sec,S100 : Word;
  6.    TC: Longint; {used in calculating TimeCalled}
  7. {  UserNumber:       }
  8.    UserAlias:  String[20];
  9.    Username:   String[25];
  10. {  UserCall:         }
  11. {  UserAge:          }
  12. {  UserSex:          }
  13. {  UserGold:         }
  14. {  UserLogonDate:    }
  15. {  UserColumn:       }
  16. {  UserWidth:        }
  17. {  UserSecLev:       }
  18. {  CoSysop:          }
  19. {  Sysop:            }
  20. {  RemoteLocal:      }
  21.    UserTimeLeft: LongInt;
  22. {  GFilesdir:        }
  23. {  DataDir:          }
  24. {  CallerLog:        }
  25.    BaudRate: String[4];
  26.    Comport: Shortint;
  27.    BBSName: String[25];
  28.    BBSSysop: String[25];
  29.    TimeCalled: Longint;
  30. {  TimeOn: Longint;  }
  31. {  UploadK:          }
  32. {  Uploads:          }
  33. {  DownloadK:        }
  34. {  Downloads:        }
  35.    Parity: String[3];
  36. {------}
  37. { RBBS Variables }
  38.    FirstName,LastName: String[15];
  39.    SecondsLeft: Real;
  40.    DataSpeed: Integer; {Baud Rate, but that's used as a string}
  41.    Line: String[30];
  42.    ANSI: Boolean;
  43. {------}
  44.    ChainName, RBBSname: text; {Output and Input variables}
  45.    Blank: String[1]; {used for skipping lines and reading single chars}
  46.    I: Integer;
  47.    Error: Integer; {Error Codes}
  48.  
  49. Procedure Copyright;
  50. Begin
  51. Clrscr;
  52. HighVideo;
  53. Write ('RBBS <---> WWIV');
  54. Lowvideo;
  55. Writeln (' File Converter');
  56. Writeln;
  57. Write ('Copyright 1989 ');
  58. HighVideo;
  59. Write ('Don Kitchen');
  60. LowVideo;
  61. Write (' c/o ');
  62. HighVideo;
  63. Writeln ('MiWare, Inc.');
  64. LowVideo;
  65. Writeln ('MiWare support BBS: ');
  66. Writeln;
  67. HighVideo;
  68. Writeln ('RBBS Delta  /  (517) 631-2849');
  69. LowVideo;
  70. End;
  71.  
  72.  
  73. Procedure FatalError;
  74. Var Msg: String;
  75. Begin
  76. Msg := 'Unknown Error';
  77. Case Error of
  78.   2: Msg :=  'Input File Not Found';
  79.   3: Msg :=  'Path Not Found';
  80.   4,5,6,12: Msg :=  'Invalid Access 1)Too many files 2)Read only 3)Misc error';
  81.   15: Msg := 'Invalid Drive';
  82.   100,101: Msg := 'Disk Error';
  83.   104,105: Msg := 'Invalid File Names';
  84. End;
  85. If (Error >= 150) and (Error <= 162) then msg := 'Check Device';
  86. Writeln (Msg);
  87. Halt (1);
  88. End;
  89.  
  90. Procedure ReadRBBS;
  91. Begin
  92. {$I-} Reset (RBBSName); {$I+}
  93. Error := IOResult;
  94. If Error <> 0 then Fatalerror;
  95. { Read from DORINFO1.DEF }
  96. Readln (RBBSName, BBSName);
  97. Readln (RBBSName, BBSSysop);
  98. Readln (RBBSName, UserName);
  99. BBSSysop := BBSSysop + ' ' + UserName;
  100. For I := 1 to 4 do Read (RBBSName, Blank);
  101.   BaudRate := '';Blank := '';
  102.   ComPort := ord(Blank[1]) - 48;
  103. Readln (RBBSname, Blank);
  104. For I := 1 to 4 do
  105. Begin
  106.   Read (RBBSName, Blank);
  107.   BaudRate := BaudRate + Blank;
  108. End;
  109. For I := 1 to 7 do Read (RBBSName, Blank);
  110.   Parity := Blank;
  111. For I := 1 to 2 do Read (RBBSName, Blank);
  112.   Parity := Blank + Parity;
  113. For I := 1 to 2 do Read (RBBSName, Blank);
  114.   Parity := Parity + Blank;
  115. Readln (RBBSName, Blank);
  116. Readln (RBBSName, Blank);
  117. Readln (RBBSName, UserAlias);
  118. Readln (RBBSName, UserName);
  119.   UserName := UserAlias + ' ' + UserName;
  120. For I := 1 to 3 do Readln (RBBSName, Blank);
  121. Readln (RBBSname, UserTimeLeft);
  122.   UserTimeLeft := UserTimeLeft * 60;
  123. Close (RBBSName);
  124. End;
  125.  
  126. Procedure WriteRBBS;
  127. Begin
  128. {$I-} Rewrite (RBBSName); {$I+}
  129. Error := IOResult;
  130. If Error <> 0 then Fatalerror;
  131. Writeln (RBBSName,BBSName);
  132. Begin
  133.   I := 0;
  134.   While (BBSSysop[I] <> ' ') and not (I > Length(BBSSysop)) do Inc(I);
  135. Writeln (RBBSName,Copy(BBSSysop,1,I-1));
  136. Writeln (RBBSName,Copy(BBSSysop,I+1,20));
  137. Writeln (RBBSName,'COM',Comport);
  138. Write (RBBSName,Dataspeed, ' BAUD,',Copy(Parity,2,1));
  139. Writeln (RBBSName,',',Copy(Parity,1,1),',',Copy(Parity,3,1));
  140. Writeln (RBBSName,' 7 ');
  141. Writeln (RBBSName,FirstName);
  142. Writeln (RBBSName,LastName);
  143. Writeln (RBBSName, 'MIDLAND, MI             ');
  144. Write (RBBSName,' ');
  145. If ANSI then writeln (RBBSName,'3 ') else Writeln (RBBSName,'1 ');
  146. Writeln (RBBSName,' 20 ');
  147. Writeln (RBBSName,' ',Trunc(SecondsLeft/60),' ');
  148. Writeln (RBBSName,' 0 ');
  149. End;
  150. Close (RBBSName);
  151. End;
  152.  
  153. Procedure WriteChain;
  154. Begin
  155. {$I-} Rewrite (ChainName); {$I+}
  156. Error := IOResult;
  157. If Error <> 0 then FatalError;
  158. { Write CHAIN.TXT information }
  159. Writeln (ChainName,'1');
  160. Writeln (ChainName,UserAlias);
  161. Writeln (ChainName,UserName);
  162. Writeln (ChainName,'');
  163. Writeln (ChainName,'21');
  164. Writeln (ChainName,'M');
  165. Writeln (ChainName,'  16097.00');
  166.   GetDate (Year,Mon,Day,DW);
  167. Writeln (ChainName,Mon,'/',Day,'/',Year-1900);
  168. Writeln (ChainName,'80');
  169. Writeln (ChainName,'25');
  170. Writeln (ChainName,'20');
  171. Writeln (ChainName,'0');
  172. Writeln (ChainName,'0');
  173. Writeln (ChainName,'0');
  174. Writeln (ChainName,'1');
  175. Writeln (ChainName,UserTimeLeft:7,'.00');
  176. Writeln (ChainName,'E:\TEMP\');
  177. Writeln (ChainName,'E:\TEMP\');
  178. Writeln (ChainName,'Junk.log');
  179. Writeln (ChainName, BaudRate);
  180. Writeln (ChainName, ComPort);
  181. Writeln (ChainName, BBSName);
  182. Writeln (ChainName, BBSSysop);
  183.   GetTime (Hour,Min,Sec,S100);
  184.   TC := Hour;
  185.   TC := TC * 3600;
  186.   TimeCalled := TC + Sec - 120;
  187.   TC := Min;
  188.   TC := TC * 60;
  189.   TimeCalled := TimeCalled + TC;
  190. Writeln (ChainName, TimeCalled);
  191. Writeln (ChainName, '120');
  192. Writeln (ChainName, '0');
  193. Writeln (ChainName, '0');
  194. Writeln (ChainName, '0');
  195. Writeln (ChainName, '0');
  196. Writeln (ChainName, Parity);
  197. Close (ChainName);
  198. End;
  199.  
  200. Procedure ReadChain;
  201. Begin
  202. {$I-} Reset (ChainName); {$I+}
  203. Error := IOResult;
  204. If Error <> 0 then Fatalerror;
  205. Readln (ChainName, Blank);
  206. Readln (ChainName, Blank);
  207. Readln (ChainName, Line);
  208. Begin
  209.   I := 1;
  210.   While Line[I] <> ' ' do Inc(I);
  211.   Firstname := Copy(Line,1,I-1);
  212.   Lastname := Copy(Line,I+1,15);
  213. End;
  214. For I := 1 to 10 do Readln (ChainName, Blank);
  215. Readln (ChainName, Blank);
  216. If Blank = '1' then ANSI := True;
  217. Readln (ChainName, Blank);
  218. Readln (ChainName, SecondsLeft);
  219. For I := 1 to 3 do Readln (ChainName, Blank);
  220. Readln (ChainName, DataSpeed);
  221. Readln (ChainName, ComPort);
  222. Readln (ChainName, BBSName);
  223. Readln (ChainName, BBSSysop);
  224. For I := 1 to 6 do Readln (ChainName, Blank);
  225. Readln (ChainName, Parity);
  226. Close (ChainName);
  227. End;
  228.  
  229. Begin
  230. DirectVideo := False;
  231. Ansi := False;
  232. Copyright;
  233.   Assign (RBBSName,'DORINFO1.DEF');
  234.   Assign (ChainName, 'CHAIN.TXT');
  235. Blank := Paramstr(1);
  236. If Upcase(Blank[1]) = 'R' then
  237. Begin
  238.   ReadRBBS;
  239.   WriteChain;
  240.   Halt (0);
  241. End;
  242. If Upcase(Blank[1]) = 'W' then
  243. Begin
  244.   ReadChain;
  245.   WriteRBBS;
  246.   Halt (0);
  247. End;
  248. Begin
  249.   Writeln;
  250.   Writeln ('parameters-Host: R)BBS W)WIV');
  251.   Halt (1);
  252. End;
  253. End.
  254.