home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 2 BBS / 02-BBS.zip / SHOWMSG.LZH / SHOWMSG.CMD
OS/2 REXX Batch file  |  1991-10-06  |  15KB  |  489 lines
  1. /*
  2.     SHOWMSG.CMD
  3.  
  4.     This program shows the contents of a FIDO-message.
  5.  
  6.     It was originally meant as a utility with which you could delete a
  7.     'thread' of messages. I want to keep my messageareas as 'clean' as 
  8.     possible, especially the OS2 area. I have always 500-1000 messages 
  9.     in this area and while I am reading, I kill all messages of no 
  10.     interest to me using Alt-D in MsgEd.
  11.     When I see a long boring (political) discussion which I definitly
  12.     do not want to keep, I use this Rexx program to kill the whole 
  13.     bunch at once.
  14.     You can also use this program to read your mail, although it is a 
  15.     bit slow.
  16.  
  17.     Jaap Geluk, 8 september 1991
  18. */
  19. trace off
  20.  
  21. arg tCmdAreaName nCmdMsg
  22.  
  23.                                      /* I use CMD.EXE SetLocal instead of
  24.                                         Rexx SetLocal because with OS/2 
  25.                                         2.0 6.149 I can't get it to work
  26.                                         as I expect. */
  27. address cmd '@setlocal'                 /* Save drive, directory en envir. */
  28.  
  29. /*
  30. On my pointsystem I call SETENV.CMD first in all my Rexx files.
  31. SetEnv.Cmd sets all required variables into the environment of CMD.EXE 
  32. interpret Call "'"Value('BINKLEY',,'OS2ENVIRONMENT')'\SetEnv'"'"
  33.  
  34. EchoDir          = Value('Echo',,'OS2ENVIRONMENT')
  35. NetMailDir       = Value('BinkNetMail',,'OS2ENVIRONMENT')
  36. */
  37.  
  38. tEchoDir         = 'C:\COMM\BINKLEY\ECHO'
  39. tNetMailDir      = 'C:\COMM\BINKLEY\NETMAIL'
  40.  
  41. nScreenLines     = 50                /* Number of screenlines */
  42. nScreenColumns   = 80                /* Number of screencolumns */
  43. bShowKludgeLines = 0                 /* Show Kludge lines yes or no */
  44. bShowSeenBys     = 0                 /* Show Seen-Bys yes or no */
  45. Msg.tBuf         = ''                /* Buffer for actual message */
  46. Msg.nMsg         = nCmdMsg           /* Current messagenumber (physical) */       
  47. Msg.bReadForward = 1                 /* Direction of reading */
  48. Msg.tArea        = tCmdAreaName      /* Current tAreaName */
  49. Msg.tSavArea     = ''                /* 'Static' variable used in ChechArea() */
  50. Msg.tDir         = ''                /* Full directoryname of current area */
  51. Msg.tFile        = ''                /* Full filename with dir of current msg */
  52. Msg.nNext        = 0                 /* Next message in thread */
  53. Msg.nPrev        = 0                 /* Previous message in thread */
  54.  
  55. tGlobals = 'nScreenLines nScreenColumns',
  56.            'tEchoDir tNetMailDir',
  57.            'bShowKludgeLines bShowSeenBys',
  58.            'Msg.tBuf Msg.nMsg',
  59.            'Msg.bReadForward Msg.tArea',
  60.            'Msg.tSavArea Msg.tDir Msg.tFile',
  61.            'Msg.nNext Msg.nPrev tGlobals'
  62.  
  63. address cmd '@mode co' || nScreenColumns || ',' || nScreenLines
  64.  
  65. if datatype(Msg.tArea) \= 'CHAR' then Msg.tArea = 'NETMAIL'
  66. if datatype(Msg.nMsg)  \= 'NUM'  then Msg.nMsg = 1
  67.  
  68. /*
  69.     Beginning of main loop...
  70. */
  71. do forever
  72.  
  73.   if ReadMsgFile() \= 0 then leave
  74.  
  75.   call ShowMsg
  76.  
  77.   say Msg.tArea'#'Msg.nMsg||,
  78.       '--------------------------------------------------------------'
  79.   say '<=Previous >=Next ,=Previous- .=Next-threadmessage (Q)uit'
  80.   say '(L)istthread (K)illthread (A)rea (D)elete-message Kl(u)dge (S)een-Bys'
  81.   pull tCmdChar
  82.  
  83.   select
  84.   when tCmdChar = '<' then do
  85.     Msg.nMsg = max(1, Msg.nMsg - 1)
  86.     Msg.bReadForward = 0
  87.   end
  88.   when tCmdChar = '>' then do
  89.     Msg.nMsg = Msg.nMsg + 1
  90.     Msg.bReadForward = 1
  91.   end
  92.   when tCmdChar = ',' then do
  93.     if Msg.nPrev > 0 then Msg.nMsg = Msg.nPrev
  94.     else say 'First message in thread!'
  95.     Msg.bReadForward = 0
  96.   end
  97.   when tCmdChar = '.' then do
  98.     if Msg.nNext > 0 then Msg.nMsg = Msg.nNext 
  99.     else say 'Last message in thread!'
  100.     Msg.bReadForward = 1
  101.   end
  102.   when tCmdChar = 'Q' then leave
  103.   when tCmdChar = 'L' then do
  104.     call ListThread
  105.     address cmd '@pause'
  106.   end
  107.   when tCmdChar = 'K' then call KillThread
  108.   when tCmdChar = 'D' then call DeleteMsg
  109.   when word(tCmdChar,1) = 'A' then do
  110.     if words(tCmdChar) = 2 then Msg.tArea = word(tCmdChar, 2)
  111.     else pull Msg.tArea
  112.     Msg.nMsg = 1
  113.     call CheckArea
  114.   end
  115.   when tCmdChar = 'U' then bShowKludgeLines = \ bShowKludgeLines
  116.   when tCmdChar = 'S' then bShowSeenBys     = \ bShowSeenBys
  117.   when datatype(tCmdChar) = 'NUM' then Msg.nMsg = tCmdChar
  118.   otherwise
  119.     say tCmdChar' is an unsupported tCmdChar...'
  120.   end
  121.  
  122. end
  123. exit 0                              /* End of ShowMsg.CMD */
  124.  
  125. /* =============================== FUNCTIONS =================================*/
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132. /* ==========================================================================
  133.     NextPos
  134.  
  135.     This function is used by ShowMsg()
  136. */
  137. NextPos: procedure
  138. parse arg pos3 pos4
  139. if pos3 < 1 then return pos4
  140. if pos4 < 1 then return pos3
  141. return min(pos3, pos4)
  142.  
  143. /* ==========================================================================
  144.     Word2Dec
  145.  
  146.     Converts a word (a 2-byte CHAR variable) into a decimal value
  147. */
  148. Word2Dec: procedure
  149. return C2D(translate('21', arg(1), '12'))
  150.  
  151. /* ==========================================================================
  152.     Long2Dec
  153.  
  154.     Converts a long (a 4-byte CHAR variable) into a decimal value
  155. */
  156. Long2Dec: procedure
  157. return C2D(translate('2143', arg(1), '1234'))
  158.  
  159. /* ==========================================================================
  160.     Long2Date
  161.  
  162.     Converts a long (a 4-byte CHAR variable) into a date-string.
  163.     Use by ShowMsg() to show the dates...
  164. */
  165. Long2Date: procedure
  166. parse arg long
  167. /*
  168.   This is not working, yet...
  169.   Can't find what the problem is. Nor do I have the time. 
  170.   Could not exactly find out what all the bits EXACTLY mean...
  171. */
  172. BinDate = X2B(C2X(translate('1234', long, '1234')))
  173. day = X2D(B2X(substr(BinDate,  1, 5)))
  174. mon = X2D(B2X(substr(BinDate,  6, 4))) - 1
  175. yea = X2D(B2X(substr(BinDate, 10, 7))) + 80
  176. sec = X2D(B2X(substr(BinDate, 17, 5))) * 2
  177. min = X2D(B2X(substr(BinDate, 22, 6)))
  178. hou = X2D(B2X(substr(BinDate, 28, 5)))
  179. /* Below you see the Dutch way of saying what the time is... :-) */
  180. return day'-'mon'-'yea'  'hou':'min':'sec
  181.  
  182. /* ==========================================================================
  183.     bool = CheckArea()
  184.  
  185.     bool = true on return if Msg.tAreaName was valid.
  186.  
  187.     Checks if Msg.tAreaName is valid. If not, on return Msg.tAreaName will
  188.     be equal to 'NETMAIL'.
  189.     If Msg.tAreaName is not different from the value used when CheckArea
  190.     was called before, CheckArea will return immediatly.
  191. */
  192. CheckArea: procedure expose (tGlobals)
  193.  
  194. tLocAreaName = Msg.tArea
  195. if tLocAreaName = Msg.tSavArea then return 0
  196. Msg.tSavArea = tLocAreaName
  197.  
  198. if tLocAreaName = '' then tLocAreaName = 'NETMAIL'
  199.  
  200. if tLocAreaName \= 'NETMAIL' then do
  201.  
  202.   /* Prefix tAreaName with full directory name */
  203.   tLocAreaDir = tEchoDir'\'tLocAreaName 
  204.  
  205.   /* Test for the existence of the area-dir */
  206.   if \ Exist(tLocAreaDir'\*.*') then do  
  207.     say tLocAreaName' does not exist!'
  208.     Msg.tArea = 'NETMAIL'
  209.     Msg.tDir  = tNetMailDir
  210.   end
  211.   else do
  212.     Msg.tArea = tLocAreaName
  213.     Msg.tDir  = tLocAreaDir
  214.   end
  215. end
  216. else do
  217.   Msg.tDir = tNetMailDir
  218. end
  219. return 0
  220.  
  221. /* ==========================================================================
  222.     MakeFIleName
  223.  
  224.     'Composes' a complete filename (with directory) for the current
  225.     messagefile.
  226. */
  227. MakeFileName: procedure expose (tGlobals)
  228. Msg.tFile = Msg.tDir'\'Msg.nMsg'.MSG'
  229. return
  230.  
  231.                                                             
  232. /* ==========================================================================
  233.     bool = ReadMsgFile()
  234.  
  235.     bool = true when all went ok
  236.  
  237.     This routine opens the specified .MSG file in read-only mode, reads
  238.     everything into the Msg structure and closes the file.
  239. */
  240. ReadMsgFile: procedure expose (tGlobals)
  241.  
  242. if CheckArea() \= 0 then return 1
  243.  
  244. do i = 1 to 10
  245.   call MakeFileName
  246.  
  247.   if stream(Msg.tFile, 'c', 'query exists') = Msg.tFile then leave
  248.  
  249.   if Msg.bReadForward then
  250.     Msg.nMsg = Msg.nMsg + 1
  251.   else
  252.     Msg.nMsg = Msg.nMsg - 1
  253.  
  254.   if Msg.nMsg < 1 then leave
  255. end
  256.  
  257. if i > 10 | Msg.nMsg < 1 then return 1
  258.  
  259. if stream(Msg.tFile, 'c', 'open read') \= 'READY' then do
  260.   say Msg.tFile' could not be opened for reading...'
  261.   return 1
  262. end
  263.  
  264. Msg.tBuf = charin(Msg.tFile, 1, stream(Msg.tFile, 'c', 'query size'))
  265.  
  266. if stream(Msg.tFile, 'c', 'close') \= 'READY' then do
  267.   say Msg.tFile' could not be closed...'
  268.   return 1
  269. end
  270. Msg.nPrev = Word2Dec(substr(Msg.tBuf, X2D('B9'), 02))
  271. Msg.nNext = Word2Dec(substr(Msg.tBuf, X2D('BD'), 02))
  272. return 0                           /* End of ReadMsgFile() */
  273.  
  274.  
  275.  
  276. /* ==========================================================================
  277.     ShowMsg (Msg)
  278.  
  279.     This routine shows the contents of a message on screen.
  280.     Before doing that, the screen is cleared.
  281.  
  282. */
  283. ShowMsg: procedure expose (tGlobals)
  284.  
  285. address cmd '@cls'
  286. say 'From        :' strip(substr(Msg.tBuf, X2D('01'), 36), 'T', '00'X)
  287. say 'To          :' strip(substr(Msg.tBuf, X2D('25'), 36), 'T', '00'x)
  288. say 'Subject     :' strip(substr(Msg.tBuf, X2D('49'), 72), 'T', '00'x)
  289. say 'Date        :' strip(substr(Msg.tBuf, X2D('91'), 20), 'T', '00'x)
  290. say 'Times read  :'   Word2Dec(substr(Msg.tBuf, X2D('A5'), 02))
  291. say 'Dest. node  :'   Word2Dec(substr(Msg.tBuf, X2D('A7'), 02))
  292. say 'Org. node   :'   Word2Dec(substr(Msg.tBuf, X2D('A9'), 02))
  293. say 'Cost        :'   Word2Dec(substr(Msg.tBuf, X2D('AB'), 02))
  294. say 'Org. net    :'   Word2Dec(substr(Msg.tBuf, X2D('AD'), 02))
  295. say 'Dest. net   :'   Word2Dec(substr(Msg.tBuf, X2D('AF'), 02))
  296. /* say 'Date written:'  Long2Date(substr(Msg.tBuf, X2D('B1'), 04)) */
  297. /* say 'Date arrived:'  Long2Date(substr(Msg.tBuf, X2D('B5'), 04)) */
  298. /* 
  299.    If you put the above lines back on screen, remember to change the value
  300.    of nCurLine from 16 to 18
  301. */
  302. say 'Reply       :' Msg.nNext
  303. say 'Unreply     :' Msg.nPrev
  304. Attr =        X2B(D2X(Word2Dec(substr(Msg.tBuf, X2D('BB'), 02))))
  305. Tmp  = ''
  306. if substr(Attr, 01, 1) = '1' then Tmp = Tmp'Private '
  307. if substr(Attr, 02, 1) = '1' then Tmp = Tmp'Crash '
  308. if substr(Attr, 03, 1) = '1' then Tmp = Tmp'Read '
  309. if substr(Attr, 04, 1) = '1' then Tmp = Tmp'Sent '
  310. if substr(Attr, 05, 1) = '1' then Tmp = Tmp'Attach '
  311. if substr(Attr, 06, 1) = '1' then Tmp = Tmp'Forwarded '
  312. if substr(Attr, 07, 1) = '1' then Tmp = Tmp'Orphan '
  313. if substr(Attr, 08, 1) = '1' then Tmp = Tmp'Kill/sent '
  314. if substr(Attr, 09, 1) = '1' then Tmp = Tmp'Local '
  315. if substr(Attr, 10, 1) = '1' then Tmp = Tmp'Hold '
  316. if substr(Attr, 11, 1) = '1' then Tmp = Tmp'Direct '
  317. if substr(Attr, 12, 1) = '1' then Tmp = Tmp'Request '
  318. if substr(Attr, 13, 1) = '1' then Tmp = Tmp'Return-receipt requested '
  319. if substr(Attr, 14, 1) = '1' then Tmp = Tmp'Return-receipt '
  320. if substr(Attr, 15, 1) = '1' then Tmp = Tmp'Audit-trail requested '
  321. if substr(Attr, 16, 1) = '1' then Tmp = Tmp'Update-request '
  322.  
  323. say 'Attributes  :' Tmp
  324. say '---------------------------------------------------------------------'
  325.  
  326. SOFTCR   = D2C(141)
  327. CTRLCOD  = D2C(1)
  328. CR       = D2C(13)
  329. LF       = D2C(10)
  330. CRLF     = CR||LF
  331.  
  332. tTableO  = CR
  333. tTableI  = SOFTCR
  334. if bShowKludgeLines then do
  335.   tTableO = tTableO||'^'
  336.   tTableI = tTableI||CTRLCOD
  337. end
  338.  
  339. Msg.tBuf = translate(substr(Msg.tBuf, X2D('BF')), tTableO, tTableI)
  340.  
  341. nCurLine    = 16
  342. nMaxLineLen = nScreenColumns - 1
  343.  
  344. pos1 = 1
  345. pos2 = NextPos(pos(CR, Msg.tBuf, pos1), pos(CRLF, Msg.tBuf, pos1))
  346. do while pos2 > 0
  347.   if nCurLine > nScreenLines then do
  348.     address cmd '@pause'
  349.     address cmd '@cls'
  350.     nCurLine = 0
  351.   end
  352.  
  353.   if substr(Msg.tBuf, pos1, 1) \= CTRLCOD then do
  354.     nBeg = pos1           /* First position of current sentence */
  355.     nLen = pos2 - pos1    /* (Remaining) Lenght of current sentence */
  356.     do while nLen > 0
  357.       nLineLen = min(nMaxLineLen, nLen)
  358.       tLine    = substr(Msg.tBuf, nBeg, nLineLen)
  359.  
  360.       if nLineLen = nMaxLineLen then do
  361.         nTmp = words(tLine)
  362.         if nTmp > 1 then do
  363.           tLine = delword(tLine, nTmp)
  364.           nLineLen = length(tLine)
  365.         end
  366.       end
  367.  
  368.       say tLine
  369.  
  370.       nCurLine = nCurLine + 1
  371.       nLen = nLen - nLineLen
  372.       nBeg = nBeg + nLineLen
  373.     end
  374.   end
  375.  
  376.   if \ bShowSeenBys then do
  377.     /* Check if line begins with ' * Origin:'. If so, leave loop */
  378.     if substr(Msg.tBuf, pos1, 9) = ' * Origin' then leave
  379.   end
  380.  
  381.   pos1 = pos2 + 1
  382.   if substr(Msg.tBuf, pos1, 1) = LF then pos1 = pos1 + 1
  383.   pos2 = NextPos(pos(CR, Msg.tBuf, pos1), pos(CRLF, Msg.tBuf, pos1))
  384. end
  385. return 1                            /* End of ShowMsg */
  386.  
  387.  
  388. /* ==========================================================================
  389.     num = SearchForFirstThreadMessage()
  390.  
  391.     This function searches for the first message in a message-thread.
  392.     If it does not succeed finding it, it will return 0.
  393. */
  394. SearchForFirstThreadMessage: procedure expose (tGlobals)
  395.  
  396. do while Msg.nMsg > 0
  397.  
  398.   if ReadMsgFile() \= 0 then return 0
  399.  
  400.   if Msg.nPrev < 1 then return Msg.nMsg
  401.   Msg.nMsg = Msg.nPrev
  402. end
  403. return 0
  404.   
  405.  
  406. /* ==========================================================================
  407.     bool = ListThread(Msg)
  408.  
  409.     bool = true if everything went ok.
  410.  
  411.     Shows all messages in a thread.
  412.  
  413. */    
  414. ListThread: procedure expose (tGlobals)
  415.  
  416. nSaveCurMsg = Msg.nMsg                /* Save current message */
  417. nRet        = 0                       /* Default returnvalue */
  418.  
  419. Msg.nMsg = SearchForFirstThreadMessage()
  420.  
  421. do while Msg.nMsg > 0
  422.  
  423.   if ReadMsgFile() \= 0 then do
  424.     nRet = 1
  425.     leave
  426.   end
  427.  
  428.   say '#'Msg.nMsg':' strip(substr(Msg.tBuf, X2D('49'), 72), 'T', '00'x)
  429.   Msg.nMsg = Msg.nNext
  430. end
  431. Msg.nMsg = nSaveCurMsg
  432. return nRet
  433.  
  434.  
  435. /* ==========================================================================
  436.     KillThread
  437.  
  438.     First calls ListThread, asks you for a confirmation and then kills all 
  439.     messages in a thread.
  440. */
  441. KillThread: procedure expose (tGlobals)
  442.  
  443. address cmd '@cls'
  444.  
  445. call ListThread
  446.  
  447. say 'Are you sure to kill this thread?'
  448. pull answer
  449. if answer \= 'Y' then return 1
  450.  
  451. nKilled = 0                           /* Number of deleted messages */
  452.  
  453. Msg.nMsg = SearchForFirstThreadMessage()
  454.  
  455. do while Msg.nMsg > 0
  456.  
  457.   if ReadMsgFile() \= 0 then return 1
  458.  
  459.   say '#'Msg.nMsg':' strip(substr(Msg.tBuf, X2D('49'), 72), 'T', '00'x)
  460.   address cmd '@del' Msg.tFile
  461.   nKilled  = nKilled + 1
  462.   Msg.nMsg = Msg.nNext
  463. end
  464. say nKilled' messages killed...'
  465. pull key
  466. return 0
  467.  
  468. /* ==========================================================================
  469.     DeleteMsg
  470.  
  471.     Deletes the 'current' msg described in the stemvariable Msg.
  472. */
  473. DeleteMsg: procedure expose (tGlobals)
  474.  
  475. if CheckArea() \= 0 then return 1
  476.  
  477. call MakeFileName
  478. address cmd '@del' Msg.tFile
  479. return 0
  480.  
  481. /* ==========================================================================
  482.     bool = Exist(tDirName)
  483.  
  484.     Used to test if a directory exists.
  485. */
  486. Exist: procedure
  487. address cmd '@if exist' arg(1) 'dir nul 1>nul 2>nul'
  488. return rc
  489.