' ------------------------------------------------------------------------
' QB 4.5 code for writing a QuickBBS msg base style msg.

' By Mark E. Moran
' (c) copyright 1991
' 1:273/603 Fidonet

' I make no guarantees on this code other than it'll take up disk space.
' IE., use it at your OWN risk  (BACKUP MSG*.BBS BEFORE you use this!)

' You may use this code as you you wish, for free, but I do retain
' a copyright on it.  This means you can't sell it, or redistribute it.

' If you do make improvements on this code I'd like to see them.  You
' can send them or any comments to the above FIDONET address.

' Special thanks to Mike Janke, who's QBSTRUCT.BAS gave me most of the
' file structure types

' ------------------------------------------------------------------------

TYPE MsgIdx                            ' MSGIDX.BBS
  MsgNum  AS INTEGER
  BoardNum AS STRING * 1
END TYPE

TYPE HdrRecord                         ' MSGHDR.BBS
    msgnumb     AS INTEGER
    replyto     AS INTEGER
    seealso     AS INTEGER
    tread       AS INTEGER
    startrec1   AS STRING * 1       ' Kludge because QB can't handle
    startrec2   AS STRING * 1       ' unsigned integers
    numrecs     AS INTEGER
    destnet     AS INTEGER
    destnode    AS INTEGER
    orignet     AS INTEGER
    orignode    AS INTEGER
    destzone    AS STRING * 1
    origzone    AS STRING * 1
    cost        AS INTEGER
    msgattr     AS STRING * 1
    netattr     AS STRING * 1
    board       AS STRING * 1
    lenposttime AS STRING * 1
    posttime    AS STRING * 5
    lenpostdate AS STRING * 1
    postdate    AS STRING * 8
    lenwhoto    AS STRING * 1
    whoto       AS STRING * 35
    lenwhofrom  AS STRING * 1
    whofrom     AS STRING * 35
    lensubj     AS STRING * 1
    subj        AS STRING * 72
END TYPE

TYPE MsgText                           ' MSGTXT.BBS
   lineleng AS STRING * 1
   lines AS STRING * 255
END TYPE

TYPE MsgToIdx                          ' MSGIDX.BBS
   NameLen AS STRING * 1
   ToWho AS STRING * 35
END TYPE

TYPE MsgInfo                           ' MSGINFO.BBS
   lowmsg AS INTEGER
    himsg AS INTEGER
 totalmsg AS INTEGER
 nummsgs AS INTEGER
 'nummsgs1 as integer
 'nummsgs2 as integer
 somestuf AS STRING * 197  'You can't type an array in QB as you can
 morestuf AS STRING * 197  'with Pascal, so to use the pascal
                           'ARRAY[1..200] OF INTEGER you would have
                           ' to list 200 individual "Variable As Integer"
                           ' in this type definition.
                           ' Each stores the total msgs for the 200 possible
                           ' msg areas
END TYPE

TYPE Config                            ' CONFIG.BBS
   CommPort AS INTEGER
   InitBaud AS INTEGER
   InitTimes AS INTEGER
   AnswerWait AS INTEGER
   ModemInitStrlen AS STRING * 1
   ModemInitStr AS STRING * 70
   ModemBusyStrlen AS STRING * 1
   ModemBusyStr AS STRING * 70
   ModemInitResplen AS STRING * 1
   ModemInitResp AS STRING * 40
   ModemBusyResplen AS STRING * 1
   ModemBusyResp AS STRING * 40
   Resp300len AS STRING * 1
   Resp300 AS STRING * 40
   Resp1200len AS STRING * 1
   Resp1200 AS STRING * 40
   Resp2400len AS STRING * 1
   Resp2400 AS STRING * 40
   MenuPathlen AS STRING * 1
   MenuPath AS STRING * 66
   TextPathlen AS STRING * 1
   TextPath AS STRING * 66
   NetPathlen AS STRING * 1
   NetPath AS STRING * 66
   MinBaud AS INTEGER
   GraphicsBaud AS INTEGER
   XferBaud AS INTEGER
   LowBaudStartlen AS STRING * 1
   LowBaudStart AS STRING * 5
   LowBaudEndlen AS STRING * 1
   LowBaudEnd AS STRING * 5
   DownloadStartlen AS STRING * 1
   DownloadStart AS STRING * 5
   DownloadEndlen AS STRING * 1
   DownloadEnd AS STRING * 5
   PagingStartlen AS STRING * 1
   PagingStart AS STRING * 5
   PagingEndlen AS STRING * 1
   PagingEnd AS STRING * 5
   MatrixZone AS INTEGER
   MatrixNet AS INTEGER
   MatrixNode AS INTEGER
   AkaNet AS STRING * 5
   AkaNode AS STRING * 5
   NetMailBoard AS INTEGER
   DefaultSec AS INTEGER
   DefaultCredit AS INTEGER
   DefaultFlags AS STRING * 14
   EditorCmdStrlen AS STRING * 1
   EditorCmdStr AS STRING * 70
   OriginLinelen AS STRING * 1
   OriginLine AS STRING * 60
   SysopNamelen AS STRING * 1
   SysopName AS STRING * 35
' Don't need the rest
END TYPE

DECLARE SUB Writemsg (ToWho$, Config AS ANY, msg$(), wnl%)

DIM Config AS Config, msg$(8), st$(8)

cg% = FREEFILE                         ' Read CONFIG.BBS
OPEN "F:\QBBS\CONFIG.BBS" FOR RANDOM ACCESS READ AS #cg% LEN = LEN(Config)
   GET #cg%, 1, Config
CLOSE #cg%

' Text to be written
st$(1) = "Dear Mark,"
st$(2) = ""
st$(3) = "Thank you so very much for providing me with this great code."
st$(4) = "I realize it must have taken you many long hours to reverse"
st$(5) = "engineer all this.  It is greatly appreciated."
st$(6) = ""
st$(7) = "Signed,"
st$(8) = "Indebted Programmer"
nl% = 8  'Total number of lines


' Each record in MSGTXT.BBS is 255 bytes long
' So we want to cram as much as we can in each record
' The following will fill up an ARRAY msg$() with your msg marking the
' end of each line with a CR/LF, but putting more than the usual 80 chars
' on a line in each variable
  
   mnl% = 1
   FOR x% = 1 TO nl%
      spclft% = 255 - LEN(msg$(mnl%))
      IF LEN(st$(nl%)) > spclft% THEN
         msg$(mnl%) = msg$(mnl%) + LEFT$(st$(x%), spclft%)
         mnl% = mnl% + 1
         msg$(mnl%) = RIGHT$(st$(x%), LEN(st$(x%)) - spclft%)
      ELSE
         msg$(mnl%) = msg$(mnl%) + st$(x%)
      END IF
      ' Add CR/LF
      msg$(mnl%) = msg$(mnl%) + CHR$(13) + CHR$(10)
   NEXT x%

   msg$(0) = "Subject line"

   Writemsg "Mark Moran", Config, msg$(), mnl%

SUB Writemsg (ToWho$, Config AS Config, msg$(), wnl%) STATIC

DIM HdrRecord AS HdrRecord
DIM MsgToIdx AS MsgToIdx
DIM MsgInfo AS MsgInfo
DIM MsgText AS MsgText
DIM MsgIdx AS MsgIdx

QBBSdir$ = "F:\QBBS\"

' Get high msg
mg% = FREEFILE
OPEN QBBSdir$ + "MSGINFO.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgInfo)
   GET #mg%, 1, MsgInfo
   MsgInfo.himsg = MsgInfo.himsg + 1
   MsgInfo.totalmsg = MsgInfo.totalmsg + 1

   ' Here you increase the total msg for the particular msg board
   ' This defaults to Msg area #1
   ' You have to add to the TYPE MSGINFO in the main module to write
   ' msg's to other boards  (see the comment there.)
   MsgInfo.nummsgs = MsgInfo.nummsgs + 1

   PUT #mg%, 1, MsgInfo
CLOSE #mg%

mg% = FREEFILE
OPEN QBBSdir$ + "MSGTXT.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgText)
msgtxtstart& = LOF(mg%) / LEN(MsgText)  'Get start position for msg text

' Write msgtxt.bbs
FOR x% = 1 TO wnl%
   MsgText.lineleng = CHR$(LEN(msg$(x%)))
   MsgText.lines = msg$(x%)
   PUT #mg%, msgtxtstart& + x%, MsgText
NEXT x%
CLOSE #mg%

'Set variables for MSGHDR.BBS

HdrRecord.msgnumb = MsgInfo.himsg

HdrRecord.replyto = 0
HdrRecord.seealso = 0
HdrRecord.tread = 0

'Kludge to write an unsigned integer (0 to 65534)
HdrRecord.startrec1 = CHR$(msgtxtstart& MOD 256)    ' Low
HdrRecord.startrec2 = CHR$(INT(msgtxtstart& / 256)) ' High

HdrRecord.numrecs = wnl%                ' How many records this msg is

HdrRecord.destnet = Config.MatrixNet    ' Defaults to your address
HdrRecord.destnode = Config.MatrixNode  ' in config.sys
HdrRecord.orignet = Config.MatrixNet
HdrRecord.orignode = Config.MatrixNode
HdrRecord.destzone = CHR$(Config.MatrixZone)
HdrRecord.origzone = CHR$(Config.MatrixZone)

HdrRecord.cost = 0

HdrRecord.msgattr = CHR$(72)            ' Set Private & Local Bits

' Msg Attributes:                            To Set add:

'      Bit 0: Deleted                        1
'      Bit 1: Unmoved Outgoing Net Message   2
'      Bit 2: Is a Net Mail Message          4
'      Bit 3: Private                        8
'      Bit 4: Received                       16
'      Bit 5: Unmoved Outgoing Echo Message  32
'      Bit 6: Local Bit                      64
'
' EG., to mark a msg as Private and received you'd set it to: 16+8 or 24

HdrRecord.netattr = CHR$(0)             ' This only writes echo msg areas

HdrRecord.board = "1"                   ' See comments in TYPE MSGINFO
HdrRecord.lenposttime = CHR$(5)
HdrRecord.posttime = LEFT$(TIME$, 5)
HdrRecord.lenpostdate = CHR$(8)
HdrRecord.postdate = LEFT$(DATE$, 6) + RIGHT$(DATE$, 2)  ' FORMAT: 11-26-90
HdrRecord.lenwhoto = CHR$(LEN(ToWho$))
HdrRecord.whoto = ToWho$
HdrRecord.lenwhofrom = Config.SysopNamelen       ' Defaults to SYSOP
HdrRecord.whofrom = LEFT$(Config.SysopName, ASC(Config.SysopNamelen))
HdrRecord.lensubj = CHR$(LEN(msg$(0)))
HdrRecord.subj = msg$(0)

' Write the msg header
mg% = FREEFILE
OPEN QBBSdir$ + "MSGHDR.BBS" FOR RANDOM AS #mg% LEN = LEN(HdrRecord)
   num% = LOF(mg%) / LEN(HdrRecord) + 1
   PUT #mg%, num%, HdrRecord
CLOSE #mg%

' Set info for 'to' index
MsgToIdx.NameLen = CHR$(LEN(ToWho$))
MsgToIdx.ToWho = ToWho$

' Write msgtoidx.bbs
mg% = FREEFILE
OPEN QBBSdir$ + "MSGTOIDX.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgToIdx)
   PUT #mg%, num%, MsgToIdx
CLOSE #mg%

' Set info for index
MsgIdx.MsgNum = MsgInfo.himsg
MsgIdx.BoardNum = CHR$(1)

'Write msgidx.bbs
mg% = FREEFILE
OPEN QBBSdir$ + "MSGIDX.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgIdx)
   PUT #mg%, num%, MsgIdx
CLOSE #mg%
END SUB