home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / qbbsetc / qbwrtmsg.lzh / QBWRTMSG.BAS
BASIC Source File  |  1991-02-09  |  9KB  |  303 lines
  1. ' ------------------------------------------------------------------------
  2. ' QB 4.5 code for writing a QuickBBS msg base style msg.
  3.  
  4. ' By Mark E. Moran
  5. ' (c) copyright 1991
  6. ' 1:273/603 Fidonet
  7.  
  8. ' I make no guarantees on this code other than it'll take up disk space.
  9. ' IE., use it at your OWN risk  (BACKUP MSG*.BBS BEFORE you use this!)
  10.  
  11. ' You may use this code as you you wish, for free, but I do retain
  12. ' a copyright on it.  This means you can't sell it, or redistribute it.
  13.  
  14. ' If you do make improvements on this code I'd like to see them.  You
  15. ' can send them or any comments to the above FIDONET address.
  16.  
  17. ' Special thanks to Mike Janke, who's QBSTRUCT.BAS gave me most of the
  18. ' file structure types
  19.  
  20. ' ------------------------------------------------------------------------
  21.  
  22. TYPE MsgIdx                            ' MSGIDX.BBS
  23.   MsgNum  AS INTEGER
  24.   BoardNum AS STRING * 1
  25. END TYPE
  26.  
  27. TYPE HdrRecord                         ' MSGHDR.BBS
  28.     msgnumb     AS INTEGER
  29.     replyto     AS INTEGER
  30.     seealso     AS INTEGER
  31.     tread       AS INTEGER
  32.     startrec1   AS STRING * 1       ' Kludge because QB can't handle
  33.     startrec2   AS STRING * 1       ' unsigned integers
  34.     numrecs     AS INTEGER
  35.     destnet     AS INTEGER
  36.     destnode    AS INTEGER
  37.     orignet     AS INTEGER
  38.     orignode    AS INTEGER
  39.     destzone    AS STRING * 1
  40.     origzone    AS STRING * 1
  41.     cost        AS INTEGER
  42.     msgattr     AS STRING * 1
  43.     netattr     AS STRING * 1
  44.     board       AS STRING * 1
  45.     lenposttime AS STRING * 1
  46.     posttime    AS STRING * 5
  47.     lenpostdate AS STRING * 1
  48.     postdate    AS STRING * 8
  49.     lenwhoto    AS STRING * 1
  50.     whoto       AS STRING * 35
  51.     lenwhofrom  AS STRING * 1
  52.     whofrom     AS STRING * 35
  53.     lensubj     AS STRING * 1
  54.     subj        AS STRING * 72
  55. END TYPE
  56.  
  57. TYPE MsgText                           ' MSGTXT.BBS
  58.    lineleng AS STRING * 1
  59.    lines AS STRING * 255
  60. END TYPE
  61.  
  62. TYPE MsgToIdx                          ' MSGIDX.BBS
  63.    NameLen AS STRING * 1
  64.    ToWho AS STRING * 35
  65. END TYPE
  66.  
  67. TYPE MsgInfo                           ' MSGINFO.BBS
  68.    lowmsg AS INTEGER
  69.     himsg AS INTEGER
  70.  totalmsg AS INTEGER
  71.  nummsgs AS INTEGER
  72.  'nummsgs1 as integer
  73.  'nummsgs2 as integer
  74.  somestuf AS STRING * 197  'You can't type an array in QB as you can
  75.  morestuf AS STRING * 197  'with Pascal, so to use the pascal
  76.                            'ARRAY[1..200] OF INTEGER you would have
  77.                            ' to list 200 individual "Variable As Integer"
  78.                            ' in this type definition.
  79.                            ' Each stores the total msgs for the 200 possible
  80.                            ' msg areas
  81. END TYPE
  82.  
  83. TYPE Config                            ' CONFIG.BBS
  84.    CommPort AS INTEGER
  85.    InitBaud AS INTEGER
  86.    InitTimes AS INTEGER
  87.    AnswerWait AS INTEGER
  88.    ModemInitStrlen AS STRING * 1
  89.    ModemInitStr AS STRING * 70
  90.    ModemBusyStrlen AS STRING * 1
  91.    ModemBusyStr AS STRING * 70
  92.    ModemInitResplen AS STRING * 1
  93.    ModemInitResp AS STRING * 40
  94.    ModemBusyResplen AS STRING * 1
  95.    ModemBusyResp AS STRING * 40
  96.    Resp300len AS STRING * 1
  97.    Resp300 AS STRING * 40
  98.    Resp1200len AS STRING * 1
  99.    Resp1200 AS STRING * 40
  100.    Resp2400len AS STRING * 1
  101.    Resp2400 AS STRING * 40
  102.    MenuPathlen AS STRING * 1
  103.    MenuPath AS STRING * 66
  104.    TextPathlen AS STRING * 1
  105.    TextPath AS STRING * 66
  106.    NetPathlen AS STRING * 1
  107.    NetPath AS STRING * 66
  108.    MinBaud AS INTEGER
  109.    GraphicsBaud AS INTEGER
  110.    XferBaud AS INTEGER
  111.    LowBaudStartlen AS STRING * 1
  112.    LowBaudStart AS STRING * 5
  113.    LowBaudEndlen AS STRING * 1
  114.    LowBaudEnd AS STRING * 5
  115.    DownloadStartlen AS STRING * 1
  116.    DownloadStart AS STRING * 5
  117.    DownloadEndlen AS STRING * 1
  118.    DownloadEnd AS STRING * 5
  119.    PagingStartlen AS STRING * 1
  120.    PagingStart AS STRING * 5
  121.    PagingEndlen AS STRING * 1
  122.    PagingEnd AS STRING * 5
  123.    MatrixZone AS INTEGER
  124.    MatrixNet AS INTEGER
  125.    MatrixNode AS INTEGER
  126.    AkaNet AS STRING * 5
  127.    AkaNode AS STRING * 5
  128.    NetMailBoard AS INTEGER
  129.    DefaultSec AS INTEGER
  130.    DefaultCredit AS INTEGER
  131.    DefaultFlags AS STRING * 14
  132.    EditorCmdStrlen AS STRING * 1
  133.    EditorCmdStr AS STRING * 70
  134.    OriginLinelen AS STRING * 1
  135.    OriginLine AS STRING * 60
  136.    SysopNamelen AS STRING * 1
  137.    SysopName AS STRING * 35
  138. ' Don't need the rest
  139. END TYPE
  140.  
  141. DECLARE SUB Writemsg (ToWho$, Config AS ANY, msg$(), wnl%)
  142.  
  143. DIM Config AS Config, msg$(8), st$(8)
  144.  
  145. cg% = FREEFILE                         ' Read CONFIG.BBS
  146. OPEN "F:\QBBS\CONFIG.BBS" FOR RANDOM ACCESS READ AS #cg% LEN = LEN(Config)
  147.    GET #cg%, 1, Config
  148. CLOSE #cg%
  149.  
  150. ' Text to be written
  151. st$(1) = "Dear Mark,"
  152. st$(2) = ""
  153. st$(3) = "Thank you so very much for providing me with this great code."
  154. st$(4) = "I realize it must have taken you many long hours to reverse"
  155. st$(5) = "engineer all this.  It is greatly appreciated."
  156. st$(6) = ""
  157. st$(7) = "Signed,"
  158. st$(8) = "Indebted Programmer"
  159. nl% = 8  'Total number of lines
  160.  
  161.  
  162. ' Each record in MSGTXT.BBS is 255 bytes long
  163. ' So we want to cram as much as we can in each record
  164. ' The following will fill up an ARRAY msg$() with your msg marking the
  165. ' end of each line with a CR/LF, but putting more than the usual 80 chars
  166. ' on a line in each variable
  167.   
  168.    mnl% = 1
  169.    FOR x% = 1 TO nl%
  170.       spclft% = 255 - LEN(msg$(mnl%))
  171.       IF LEN(st$(nl%)) > spclft% THEN
  172.          msg$(mnl%) = msg$(mnl%) + LEFT$(st$(x%), spclft%)
  173.          mnl% = mnl% + 1
  174.          msg$(mnl%) = RIGHT$(st$(x%), LEN(st$(x%)) - spclft%)
  175.       ELSE
  176.          msg$(mnl%) = msg$(mnl%) + st$(x%)
  177.       END IF
  178.       ' Add CR/LF
  179.       msg$(mnl%) = msg$(mnl%) + CHR$(13) + CHR$(10)
  180.    NEXT x%
  181.  
  182.    msg$(0) = "Subject line"
  183.  
  184.    Writemsg "Mark Moran", Config, msg$(), mnl%
  185.  
  186. SUB Writemsg (ToWho$, Config AS Config, msg$(), wnl%) STATIC
  187.  
  188. DIM HdrRecord AS HdrRecord
  189. DIM MsgToIdx AS MsgToIdx
  190. DIM MsgInfo AS MsgInfo
  191. DIM MsgText AS MsgText
  192. DIM MsgIdx AS MsgIdx
  193.  
  194. QBBSdir$ = "F:\QBBS\"
  195.  
  196. ' Get high msg
  197. mg% = FREEFILE
  198. OPEN QBBSdir$ + "MSGINFO.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgInfo)
  199.    GET #mg%, 1, MsgInfo
  200.    MsgInfo.himsg = MsgInfo.himsg + 1
  201.    MsgInfo.totalmsg = MsgInfo.totalmsg + 1
  202.  
  203.    ' Here you increase the total msg for the particular msg board
  204.    ' This defaults to Msg area #1
  205.    ' You have to add to the TYPE MSGINFO in the main module to write
  206.    ' msg's to other boards  (see the comment there.)
  207.    MsgInfo.nummsgs = MsgInfo.nummsgs + 1
  208.  
  209.    PUT #mg%, 1, MsgInfo
  210. CLOSE #mg%
  211.  
  212. mg% = FREEFILE
  213. OPEN QBBSdir$ + "MSGTXT.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgText)
  214. msgtxtstart& = LOF(mg%) / LEN(MsgText)  'Get start position for msg text
  215.  
  216. ' Write msgtxt.bbs
  217. FOR x% = 1 TO wnl%
  218.    MsgText.lineleng = CHR$(LEN(msg$(x%)))
  219.    MsgText.lines = msg$(x%)
  220.    PUT #mg%, msgtxtstart& + x%, MsgText
  221. NEXT x%
  222. CLOSE #mg%
  223.  
  224. 'Set variables for MSGHDR.BBS
  225.  
  226. HdrRecord.msgnumb = MsgInfo.himsg
  227.  
  228. HdrRecord.replyto = 0
  229. HdrRecord.seealso = 0
  230. HdrRecord.tread = 0
  231.  
  232. 'Kludge to write an unsigned integer (0 to 65534)
  233. HdrRecord.startrec1 = CHR$(msgtxtstart& MOD 256)    ' Low
  234. HdrRecord.startrec2 = CHR$(INT(msgtxtstart& / 256)) ' High
  235.  
  236. HdrRecord.numrecs = wnl%                ' How many records this msg is
  237.  
  238. HdrRecord.destnet = Config.MatrixNet    ' Defaults to your address
  239. HdrRecord.destnode = Config.MatrixNode  ' in config.sys
  240. HdrRecord.orignet = Config.MatrixNet
  241. HdrRecord.orignode = Config.MatrixNode
  242. HdrRecord.destzone = CHR$(Config.MatrixZone)
  243. HdrRecord.origzone = CHR$(Config.MatrixZone)
  244.  
  245. HdrRecord.cost = 0
  246.  
  247. HdrRecord.msgattr = CHR$(72)            ' Set Private & Local Bits
  248.  
  249. ' Msg Attributes:                            To Set add:
  250.  
  251. '      Bit 0: Deleted                        1
  252. '      Bit 1: Unmoved Outgoing Net Message   2
  253. '      Bit 2: Is a Net Mail Message          4
  254. '      Bit 3: Private                        8
  255. '      Bit 4: Received                       16
  256. '      Bit 5: Unmoved Outgoing Echo Message  32
  257. '      Bit 6: Local Bit                      64
  258. '
  259. ' EG., to mark a msg as Private and received you'd set it to: 16+8 or 24
  260.  
  261. HdrRecord.netattr = CHR$(0)             ' This only writes echo msg areas
  262.  
  263. HdrRecord.board = "1"                   ' See comments in TYPE MSGINFO
  264. HdrRecord.lenposttime = CHR$(5)
  265. HdrRecord.posttime = LEFT$(TIME$, 5)
  266. HdrRecord.lenpostdate = CHR$(8)
  267. HdrRecord.postdate = LEFT$(DATE$, 6) + RIGHT$(DATE$, 2)  ' FORMAT: 11-26-90
  268. HdrRecord.lenwhoto = CHR$(LEN(ToWho$))
  269. HdrRecord.whoto = ToWho$
  270. HdrRecord.lenwhofrom = Config.SysopNamelen       ' Defaults to SYSOP
  271. HdrRecord.whofrom = LEFT$(Config.SysopName, ASC(Config.SysopNamelen))
  272. HdrRecord.lensubj = CHR$(LEN(msg$(0)))
  273. HdrRecord.subj = msg$(0)
  274.  
  275. ' Write the msg header
  276. mg% = FREEFILE
  277. OPEN QBBSdir$ + "MSGHDR.BBS" FOR RANDOM AS #mg% LEN = LEN(HdrRecord)
  278.    num% = LOF(mg%) / LEN(HdrRecord) + 1
  279.    PUT #mg%, num%, HdrRecord
  280. CLOSE #mg%
  281.  
  282. ' Set info for 'to' index
  283. MsgToIdx.NameLen = CHR$(LEN(ToWho$))
  284. MsgToIdx.ToWho = ToWho$
  285.  
  286. ' Write msgtoidx.bbs
  287. mg% = FREEFILE
  288. OPEN QBBSdir$ + "MSGTOIDX.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgToIdx)
  289.    PUT #mg%, num%, MsgToIdx
  290. CLOSE #mg%
  291.  
  292. ' Set info for index
  293. MsgIdx.MsgNum = MsgInfo.himsg
  294. MsgIdx.BoardNum = CHR$(1)
  295.  
  296. 'Write msgidx.bbs
  297. mg% = FREEFILE
  298. OPEN QBBSdir$ + "MSGIDX.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgIdx)
  299.    PUT #mg%, num%, MsgIdx
  300. CLOSE #mg%
  301. END SUB
  302.  
  303.