home *** CD-ROM | disk | FTP | other *** search
/ The Best of Windows 95.com 1996 December / WIN95_DEC_1996_3.ISO / addins / mich101.ZIP / MICHELLE.DAS < prev    next >
Text File  |  1996-02-29  |  26KB  |  1,005 lines

  1. '***********************************************************************
  2. '                  Internet Mail for Dana "Michelle"
  3. ' rel 1.01 96/02
  4. '***********************************************************************
  5.  
  6. '-----------------------------------------------------------------------
  7. ' The definitions of the key binds to bring up the main menu.
  8. ' You can specify two key binds.
  9. ' About key codes, see "Virtual Key Codes" and "Resident Script" 
  10. ' in Dana Script Help.
  11. '-----------------------------------------------------------------------
  12. Const KEY1   = &H0D        'VK_RETURN
  13. Const SHIFT1 = &H60        'Ctrl+Shift+
  14. Const KEY2   = &H02        'VK_RBUTTON
  15. Const SHIFT2 = &H20        'Ctrl+
  16.  
  17. Const MB_YESNO = &H04
  18. Const MB_YESNOCANCEL = &H03
  19. Const MB_ICONQUESTION = &H20
  20. Const MB_DEFBUTTON1 = &H0
  21. Const MB_DEFBUTTON2 = &H100
  22.  
  23. Const IDOK = 1
  24. Const IDCANCEL = 2
  25. Const IDYES = 6
  26. Const IDNO = 7
  27.  
  28. Declare Proc DeleteMail Lib "DanaInet.DLL" (messageno%) As Integer
  29. Declare Proc EndReceiveSession Lib "DanaInet.DLL" ()
  30. Declare Proc GetAddress Lib "DanaInet.DLL" (home$, hWnd%) As String
  31. Declare Proc GetConfiguration Lib "DanaInet.DLL" (ini$, name$, add$, login$, pop$, smtp$, del$)
  32. Declare Proc GetErrorStatus Lib "DanaInet.DLL" () As String
  33. Declare Proc GetFormValue Lib "DanaInet.DLL" (control$) As String
  34. Declare Proc GetLastMailNo Lib "DanaInet.DLL" () As String
  35. Declare Proc GetMail Lib "DanaInet.DLL" (messageno%, buf$, newlinecode%, deleteflag%) As Integer
  36. Declare Proc ListMail Lib "DanaInet.DLL" (header$, stat$) As Integer
  37. Declare Proc MailAuthenticate Lib "DanaInet.DLL" (user$) As Integer
  38. Declare Proc MailInitialize Lib "DanaInet.DLL" (pop$, smtp$, hWnd%)
  39. Declare Proc MailShutdown Lib "DanaInet.DLL" ()
  40. Declare Proc OpenSendForm Lib "DanaInet.DLL" (home$, hWnd%)
  41. Declare Proc SendMail Lib "DanaInet.DLL" (from$, add$, cc$, bcc$, subj$, content$) As Integer
  42. Declare Proc SetConfiguration Lib "DanaInet.DLL" (ini$, hWnd%)
  43. Declare Proc SetFormValue Lib "DanaInet.DLL" (control$, value$)
  44. Declare Proc StartReceiveSession Lib "DanaInet.DLL" () As Integer
  45.  
  46. Declare Proc CreateDirectory Lib "Kernel32" Alias "CreateDirectoryA" (dirname$, n$)
  47. Declare Proc SetFocus Lib "User32" (hWnd%) As Integer
  48. Declare Proc wsprintf Lib "User32" Alias "wsprintfA" (s$, fmt$, ..)
  49.  
  50. Const STATE_INIT        = 0
  51. Const STATE_KEY_PRESS   = 8
  52. Const STATE_BEFORE_EXIT = 7
  53.  
  54. Static hRecvMenu%
  55. Static nCnt%
  56. Static nNewCnt%
  57. Static bInit%
  58.  
  59. Static g_name$
  60. Static g_add$
  61. Static g_login$
  62. Static g_pop$
  63. Static g_smtp$
  64. Static g_bDel%
  65. Static g_ini$
  66. Static outbox$
  67. Static inbox$
  68.  
  69. Static sInBox$(10000)
  70.  
  71. Main ()
  72.  
  73.     Select Case .DanaState
  74.     Case STATE_INIT
  75.         g_name$ = Space$(256)
  76.         g_add$ = Space$(256)
  77.         g_login$ = Space$(256)
  78.         g_pop$ = Space$(256)
  79.         g_smtp$ = Space$(256)
  80.         g_ini$ = .HomePath + "DanaInet.INI"
  81.         UpdateConfig()
  82.         If g_pop$ = "" Or g_smtp$ = "" Then
  83.             SetConfiguration(g_ini$, .hMainWnd)
  84.             UpdateConfig()
  85.             MsgBox("To bring up the main menu" + Chr(10) + "Hit Ctrl+Shift+Enter or Ctrl+RightMouseButton")
  86.         End If
  87.         outbox$ = .HomePath + "outbox\"
  88.         inbox$  = .HomePath + "inbox\"
  89.         CreateDirectory(inbox$, 0)
  90.         CreateDirectory(outbox$, 0)
  91.         CreateDirectory(outbox$ + "sent\", 0)
  92.         StayResident()
  93.     Case STATE_KEY_PRESS
  94.         OnKeyPress(.ParmA, .ParmB)
  95.     Case STATE_BEFORE_EXIT
  96.         OnBeforeExit()
  97.     Case Else
  98.     End Select
  99.  
  100. End
  101.  
  102. '/////////////////////////////////////////////////////////
  103. ' Message handlers
  104.  
  105. '--------------------------------------------------------
  106. ' Key pressed
  107. '--------------------------------------------------------
  108. Proc OnKeyPress(nKey%, nShift%)
  109. '    Dim sCmd$
  110. '    sCmd$ = KeyToCmd(nKey, nShift)
  111.     If (nKey = KEY1 And nShift = SHIFT1) Or (nKey = KEY2 And nShift = SHIFT2) Then
  112.         InetMailMain()
  113.         .ParmA = 0
  114.     End If
  115. End Proc
  116.  
  117. '--------------------------------------------------------
  118. ' Before exit Dana
  119. '--------------------------------------------------------
  120. Proc OnBeforeExit()
  121.     MichelleExit()
  122. End Proc
  123.  
  124. '/////////////////////////////////////////////////////////
  125. ' Initialize
  126.  
  127. 'Menu ID (must be greater than 10000 and less than 17000)
  128. Const C_SEND    = 10001
  129. Const C_RECV    = 10002
  130. Const C_SENDALL = 10003
  131. Const C_REPLY   = 10004
  132. Const C_LIST    = 10005
  133. Const C_DELETE  = 10006
  134. Const C_CONFIG  = 10007
  135. Const C_RECVALL = 10008
  136. Const C_DELFILE = 10009
  137. Const C_TRASH   = 10010
  138. Const C_INBOXDAT= 10011
  139. Const C_ADDRBOOK= 10012
  140. Const C_EDITDELI= 10013
  141. Const C_OPENLOG = 10014
  142. Const C_EDITSIG = 10015
  143. Const C_EMPTYSENT= 10016
  144.  
  145. Const INBOX_DAT    = "inbox.dat"
  146. Const MAILDELI_DAT = "maildeli.dat"
  147. Const SENTMAIL_LOG = "sentmail.log"
  148. Const SIGNATURE_TXT = "sign.txt"
  149.  
  150. Const WILD_CARD = "*.*"
  151.  
  152. Const C_EXIT    = 9999
  153.  
  154. Proc MichelleExit()
  155.     Dim f$, d$
  156.     If hRecvMenu Then DiscardMenu(hRecvMenu)
  157.     If bInit Then MailShutdown()
  158.     d$ = inbox$ + "trash\"
  159.     f$ = Dir(d$ + WILD_CARD)
  160.     While f$ <> ""
  161.         FKill(d$ + f$)
  162.         f$ = Dir("")
  163.     Wend
  164. End Proc
  165.  
  166. '--------------------------------------------------------
  167. ' Main Routine
  168. '--------------------------------------------------------
  169. Proc InetMailMain ()
  170.  
  171.     Dim hMenu%, hMenuIn%, hMenuOut%, hMenuUsr%, hMenuMov%, hMenuEmpty%, hMenuSent%
  172.     hMenu = NewMenu()
  173.     If .TotLine > 0 Then            'Check this or die. :-)
  174.         If UCase(outbox$) = UCase(Left(.PathName, Len(outbox$))) Or UCase(inbox$) = UCase(Left(.PathName, Len(inbox$))) Then
  175.             hMenuMov = AddMenuItem(hMenu, "&Move", 0)
  176.             AddFolders(hMenuMov, 17000)
  177.                 AddMenuItem(hMenuMov, "&Trash Box", C_TRASH)
  178.             AddMenuItem(hMenu, "&Delete", C_DELFILE)
  179.             AddMenuItem(hMenu, "", -1)
  180.         End If
  181.     End If
  182.     AddMenuItem(hMenu, "&Receive", C_RECV)
  183.     AddMenuItem(hMenu, "Recei&ve All", C_RECVALL)
  184.     AddMenuItem(hMenu, "&Send...", C_SEND)
  185.     AddMenuItem(hMenu, "Send &All", C_SENDALL)
  186.     AddMenuItem(hMenu, "Re&ply", C_REPLY)
  187.     AddMenuItem(hMenu, "", -1)
  188.     hMenuIn = AddMenuItem(hMenu, "&InBox", 0)
  189.     CreateBox(hMenuIn, 0, "inbox")
  190.     hMenuOut = AddMenuItem(hMenu, "&OutBox", 0)
  191.     If CreateBox(hMenuOut, 100, "outbox") Then
  192.         AddMenuItem(hMenuOut, "", -1)
  193.     End If
  194.         hMenuSent = AddMenuItem(hMenuOut, "&SentBox", 0)
  195.         If CreateBox(hMenuSent, 200, "outbox\sent") Then
  196.             AddMenuItem(hMenuSent, "", -1)
  197.             AddMenuItem(hMenuSent, "&Empty SentBox", C_EMPTYSENT)
  198.         End If
  199.         AddMenuItem(hMenuOut, "Sending &Log", C_OPENLOG)
  200.     hMenuUsr = AddMenuItem(hMenu, "&UserBox", 0)
  201.     CreateUsrBox(hMenuUsr)
  202.     AddMenuItem(hMenu, "", -1)
  203.     AddMenuItem(hMenu, "Dele&te Mail on Server...", C_DELETE)
  204.     hMenuEmpty = AddMenuItem(hMenu, "Sw&eep Letter Boxes...", 0)
  205.         AddMenuItem(hMenuEmpty, "&InBox", 18000)
  206.         AddFolders(hMenuEmpty, 18000)
  207.     If nNewCnt Then
  208.         AddMenuItem(hMenu, "Today's Received Mail...", C_LIST)
  209.     End If
  210.     AddMenuItem(hMenu, "", -1)
  211.     AddMenuItem(hMenu, "Auto Deliver&y Define...", C_EDITDELI)
  212.     AddMenuItem(hMenu, "Edit Si&gnature...", C_EDITSIG)
  213.     AddMenuItem(hMenu, "Address &Book...", C_ADDRBOOK)
  214.     AddMenuItem(hMenu, "&Configuration...", C_CONFIG)
  215.     AddMenuItem(hMenu, "E&xit Michelle", C_EXIT)
  216.     Dim nRC%
  217.     nRC = DoMenu(hMenu)
  218.  
  219.     Dim sTgt$, f$
  220.  
  221.     Select Case nRC
  222.     Case C_SEND
  223.         Send()
  224.     Case C_RECV
  225.         Receive()
  226.     Case C_RECVALL
  227.         ReceiveAll()
  228.     Case C_REPLY
  229.         Reply()
  230.     Case C_LIST
  231.         ReceivedMail()
  232.     Case C_DELETE
  233.         Delete()
  234.     Case C_SENDALL
  235.         AllSend()
  236.     Case C_CONFIG
  237.         SetConfiguration(g_ini$, .hMainWnd)
  238.         UpdateConfig()
  239.     Case C_DELFILE
  240.         If MsgBox("Are you OK to delete?", "", MB_YESNO) = IDYES Then
  241.             SaveAs(.PathName)
  242.             FKill(.PathName)
  243.             Command("CloseFile")
  244.         End If
  245.     Case C_TRASH
  246.         sTgt$ = inbox$ + "trash"
  247.         CreateDirectory(sTgt$, 0)
  248.         FKill(.PathName)
  249.         SaveAs(sTgt$ + "\" + .FileName)
  250.     Case C_INBOXDAT
  251.         FileOpen(.HomePath + INBOX_DAT)
  252.     Case C_EDITDELI
  253.         FileOpen(.HomePath + MAILDELI_DAT)
  254.     Case C_EDITSIG
  255.         FileOpen(.HomePath + SIGNATURE_TXT)
  256.     Case C_ADDRBOOK
  257.         InsertString(GetAddress(.HomePath, .hMainWnd))
  258.     Case C_OPENLOG
  259.         FileOpen(.HomePath + SENTMAIL_LOG)
  260.         .Cols = 256
  261.         Command("TextBot")
  262.     Case C_EXIT
  263.         MichelleExit()
  264.         Terminate()
  265.     Case C_EMPTYSENT
  266.         sTgt$ = outbox$ + "sent\"
  267.         f$ = Dir(sTgt$ + WILD_CARD)
  268.         While f$ <> ""
  269.             FKill(sTgt$ + f$)
  270.             f$ = Dir("")
  271.         Wend
  272.     Case Else
  273.         If nRC > 0 And nRC <= 10000 Then
  274.             FileOpen(sInBox$(nRC))
  275.         Else If nRC > 17000 And nRC < 18000 Then
  276.             ' Move to
  277.             sTgt$ = inbox$ + GetMenuItem(hMenuMov, nRC)
  278.             CreateDirectory(sTgt$, 0)
  279.             FKill(.PathName)
  280.             SaveAs(sTgt$ + "\" + .FileName)
  281.         Else If nRC >= 18000 Then
  282.             ' Empty Folders
  283.             If nRC > 18000 Then
  284.                 sTgt$ = inbox$ + GetMenuItem(hMenuEmpty, nRC) + "\"
  285.             Else
  286.                 sTgt$ = inbox$
  287.             End If
  288.             EmptyFolder(sTgt$)
  289.         End If
  290.     End Select
  291.  
  292.     DiscardMenu(hMenu)
  293.  
  294. End Proc
  295.  
  296. '--------------------------------------------------------
  297. ' Server Initialize
  298. '--------------------------------------------------------
  299. Proc MailInit() As Integer
  300.     If bInit Then Return True
  301.     If MailInitialize(g_pop$, g_smtp$, .hMainWnd) Then
  302.         If MailAuthenticate(g_login$) Then
  303.             bInit = True
  304.             Return True
  305.         Else
  306.             MsgBox("Authentication failed" + Chr(10) + GetErrorStatus())
  307.             MailShutdown()
  308.             Return False
  309.         End If
  310.     Else
  311.         MsgBox("Initialization failed" + Chr(10) + GetErrorStatus())
  312.         Return False
  313.     End If
  314. End Proc
  315.  
  316. '--------------------------------------------------------
  317. ' Add Folders to Menu
  318. '--------------------------------------------------------
  319. Proc AddFolders(hMenu%, nBase%)
  320.     Dim fp%
  321.     Dim s$
  322.     Dim n%
  323.     fp = FOpen(.HomePath + INBOX_DAT, "r")
  324.     If fp Then
  325.         s$ = FGets(fp)
  326.         While s$ <> ""
  327.             s$ = Trim(s$)
  328.             If s$ <> Chr(10) And Left$(s$, 1) <> "#" Then
  329.                 n = n + 1
  330.                 AddMenuItem(hMenu, Left(s$, Len(s$)-1), nBase + n)
  331.             End If
  332.             s$ = FGets(fp)
  333.         Wend
  334.         FClose(fp)
  335.     End If
  336. End Proc
  337.  
  338. Proc CreateUsrBox(hMenu%)
  339.     Dim fp%
  340.     Dim s$, d$
  341.     Dim n%
  342.     Dim nBase%
  343.     Dim hSubMenu%
  344.     nBase = 300
  345.     fp = FOpen(.HomePath + INBOX_DAT, "r")
  346.     If fp Then
  347.         s$ = FGets(fp)
  348.         While s$ <> ""
  349.             s$ = Trim(s$)
  350.             If s$ <> Chr(10) And Left$(s$, 1) <> "#" Then
  351.                 n = n + 1
  352.                 d$ = Left(s$, Len(s$)-1)
  353.                 hSubMenu = AddMenuItem(hMenu, d$, 0)
  354.                 CreateBox(hSubMenu, nBase, "inbox\" + d$)
  355.             End If
  356.             s$ = FGets(fp)
  357.             nBase = nBase + 100
  358.         Wend
  359.         FClose(fp)
  360.     End If
  361.     hSubMenu = AddMenuItem(hMenu, "&Trash Box", 0)
  362.     CreateBox(hSubMenu, nBase, "inbox\trash")
  363.     AddMenuItem(hMenu, "", -1)
  364.     AddMenuItem(hMenu, "&Edit UserBox", C_INBOXDAT)
  365. End Proc
  366.  
  367. Proc CreateBox(hMenu%, nInit%, sDir$) As Integer
  368.     Dim s$, d$, f$, n%
  369.     d$ = .HomePath + sDir$
  370.     s$ = Dir(d$ + "\" + WILD_CARD)
  371.     While s$ <> ""
  372.         Dim h$
  373.         f$ = d$ + "\" + s$
  374.         h$ = GetHeader(f$)
  375.         If Trim(h$) <> "" Then
  376.             n = n + 1
  377.             If n > 100 Then
  378.                 Return n-1
  379.             End If
  380.             sInBox$(nInit + n) = f$
  381.             AddMenuItem(hMenu, "&" + Str(n) + " " + h$, nInit + n)
  382.         End If
  383.         s$ = Dir$("")
  384.     Wend
  385.     Return n
  386. End Proc
  387.  
  388. '--------------------------------------------------------
  389. ' Get Header Information from Mail File
  390. '--------------------------------------------------------
  391. Proc GetHeader(sFile$) As String
  392.     Dim fp%, s$, n%
  393.     Dim from$, subj$
  394.     fp = FOpen(sFile$, "r")
  395.     If fp Then
  396.         s$ = FGets(fp)
  397.         While s$ <> Chr(10) And s$ <> ""
  398.             s$ = Left(s$, Len(s$) - 1)
  399.             n = InStr(s$, ":")
  400.             If n Then
  401.                 Dim m$
  402.                 m$ = UCase(Left(s$, n - 1))
  403.                 If m$ = "FROM" Then
  404.                     from$ = Mid$(s$, n + 1, 40)
  405.                 Else If m$ = "SUBJECT" Then
  406.                     subj$ = Mid$(s$, n + 1, 40)
  407.                 End If
  408.             End If
  409.             s$ = FGets(fp)
  410.         Wend
  411.         FClose(fp)
  412.     End If
  413.     Return subj + Chr(9) + from$
  414. End Proc
  415.  
  416. '/////////////////////////////////////////////////////////
  417. ' Command routines
  418.  
  419. '--------------------------------------------------------
  420. ' Empty This Folder
  421. '--------------------------------------------------------
  422. Proc EmptyFolder(sFold$)
  423.     Dim s$
  424.     Dim nRC%
  425.     s$ = Dir(sFold$ + WILD_CARD)
  426.     If s$ = "" Then
  427.         MsgBox("This letter box is already empty.")
  428.         Return
  429.     End If
  430.     While s$ <> ""
  431.         nRC = MsgBox(Trim(GetHeader(sFold$ + s$)) + Chr(10) + "Delete this?", "", MB_YESNOCANCEL | MB_ICONQUESTION)
  432.         If nRC = IDCANCEL Then Return
  433.         If nRC = IDYES Then
  434.             FKill(sFold$ + s$)
  435.         End If
  436.         s$ = Dir("")
  437.     Wend
  438. End Proc
  439.  
  440. '--------------------------------------------------------
  441. ' Send Command
  442. '--------------------------------------------------------
  443. Proc Send()
  444.     Dim add$, subj$, cc$, bcc$, content$
  445.     Dim nRC%
  446.     Silent()
  447.     Command("SelectAll")
  448.     content$ = GetSelected()
  449.     SelectCancel()
  450.     GotoThere(1,1)
  451.     NoSilent()
  452.     Refresh()
  453.     Dim hLine%
  454.     Dim sLine$
  455.     Dim n%, nIdx%, s$
  456.     Dim sArr$(4)
  457.     Dim I%
  458.     For I = 1 To 4
  459.         sArr$(I) = ""
  460.     Next
  461.     Dim bFound%
  462.     hLine = GetTopLine()
  463.     sLine$ = LoadThisLine(hLine)
  464.     If InStr(sLine$, ":") <> 0 Then
  465.         Do
  466.             n = InStr(sLine$, ":")
  467.             If n Then
  468.                 s$ = Left(sLine$, n-1)
  469.                 Select Case UCase(s$)
  470.                 Case "TO"
  471.                     nIdx = 1
  472.                 Case "SUBJECT"
  473.                     nIdx = 2
  474.                 Case "CC"
  475.                     nIdx = 3
  476.                 Case "BCC"
  477.                     nIdx = 4
  478.                 Case Else
  479.                     nIdx = 0
  480.                 End Select
  481.                 If nIdx Then
  482.                     sArr$(nIdx) = Trim(Mid$(sLine$, n + 1))
  483.                 End If
  484.             Else If sLine$ = "" Then
  485.                 bFound = True
  486.                 Exit Do
  487.             Else
  488.                 If nIdx Then
  489.                     sArr$(nIdx) = sArr$(nIdx) + Trim(sLine$)
  490.                 End If
  491.                 Exit Do
  492.             End If
  493.             hLine = GetNext(hLine)
  494.             If hLine = 0 Then Exit Do
  495.             sLine$ = LoadThisLine(hLine)
  496.         Loop While True
  497.     End If
  498.     add$  = sArr$(1)
  499.     subj$ = sArr$(2)
  500.     cc$   = sArr$(3)
  501.     bcc$  = sArr$(4)
  502.     If bFound Then
  503.         n = InStr(content$, Chr(13) + Chr(10) + Chr(13) + Chr(10))
  504.         If n Then
  505.             content$ = Mid(content$, n + 4, Len(content$))
  506.         End If
  507.     End If
  508.     Do
  509.         SetFormValue("To", add$)
  510.         SetFormValue("Subject", subj$)
  511.         SetFormValue("Cc", cc$)
  512.         SetFormValue("Bcc", bcc$)
  513.         If OpenSendForm(.HomePath, .hMainWnd) <> IDOK Then Return
  514.         add$  = GetFormValue("To")
  515.         subj$ = GetFormValue("Subject")
  516.         cc$   = GetFormValue("Cc")
  517.         bcc$  = GetFormValue("Bcc")
  518.         If add$ <> "" Then
  519.             Exit Do
  520.         Else
  521.             MsgBox("Fill the To: field")
  522.         End If
  523.     Loop While True
  524.  
  525.     If MsgBox("Send it right now?", "", MB_YESNO) = IDYES Then
  526.         If MailInit() Then
  527.             content$ = content$ + GetSignature()
  528.             If SendMail(g_name$ + " <" + g_add$ + ">", add$, cc$, bcc$, subj$, content$) = 0 Then
  529.                 MsgBox("Failed to send" + Chr(10) + GetErrorStatus())
  530.             Else
  531.                 If UCase(outbox$) = UCase(Left(.PathName, Len(outbox$))) Then
  532.                     FKill(.PathName)
  533.                     SaveAs(outbox$ + "sent\" + .FileName)
  534.                     Command("CloseFile")
  535.                 Else
  536.                     SaveAsOutMail(add$, cc$, bcc$, subj$, content$, False)
  537.                 End If
  538.                 AddLogFile(add$, subj$)
  539.             End If
  540.         End If
  541.     Else
  542.         If UCase(outbox$) = UCase(Left(.PathName, Len(outbox$))) Then
  543.             SaveAs(.PathName)
  544.             FKill(.PathName)
  545.             Command("CloseFile")
  546.             SaveAsOutMail(add$, cc$, bcc$, subj$, content$, True)
  547.         Else
  548.             SaveAsOutMail(add$, cc$, bcc$, subj$, content$, True)
  549.         End If
  550.     End If
  551. End Proc
  552.  
  553. '--------------------------------------------------------
  554. ' Send All
  555. '--------------------------------------------------------
  556. Proc AllSend()
  557.     Dim s$, d$, tmp$, tmp2$
  558.     Dim fp%, n%
  559.     Dim add$, cc$, bcc$, subj$, content$
  560.     Dim sig$
  561.     sig$ = GetSignature()
  562.     d$ = outbox$
  563.     s$ = Dir(d$ + WILD_CARD)
  564.     If s$ = "" Then
  565.         MsgBox("There is no mail to be sent in OutBox")
  566.         Return
  567.     End If
  568.     While s$ <> ""
  569.         add$ = ""
  570.         cc$ = ""
  571.         bcc$ = ""
  572.         subj$ = ""
  573.         content$ = ""
  574.         fp = FOpen(d$ + s$, "r")
  575.         If fp Then
  576.             tmp$ = FGets(fp)
  577.             While tmp$ <> Chr(10) And tmp$ <> ""
  578.                 tmp$ = Left(tmp$, Len(tmp$) - 1)
  579.                 n = InStr(tmp$, ":")
  580.                 If n Then
  581.                     tmp2$ = UCase(Left(tmp$, n - 1))
  582.                     Select Case tmp2$
  583.                     Case "TO"
  584.                         add$ = LTrim(Mid(tmp$, n + 1))
  585.                     Case "CC"
  586.                         cc$ = LTrim(Mid(tmp$, n + 1))
  587.                     Case "BCC"
  588.                         bcc$ = LTrim(Mid(tmp$, n + 1))
  589.                     Case "SUBJECT"
  590.                         subj$ = LTrim(Mid(tmp$, n + 1))
  591.                     End Select
  592.                 End If
  593.                 tmp$ = FGets(fp)
  594.             Wend
  595.             tmp$ = FGets(fp)
  596.             While tmp$ <> ""
  597.                 StoB(tmp$, Len(tmp$) - 1, &H0D)
  598.                 content$ = content$ + tmp$ + Chr(10)
  599.                 tmp$ = FGets(fp)
  600.             Wend
  601.             FClose(fp)
  602.             If MailInit() Then
  603.                 content$ = content$ + sig$
  604.                 If SendMail(g_name$ + " <" + g_add$ + ">", add$, cc$, bcc$, subj$, content$) = 0 Then
  605.                     MsgBox("Failed to send" + Chr(10) + GetErrorStatus())
  606.                     Return
  607.                 End If
  608.                 AddLogFile(add$, subj$)
  609.                 FCopy(d$ + s$, outbox$ + "sent\" + s$)
  610.                 FKill(d$ + s$)
  611.             Else
  612.                 Return
  613.             End If
  614.         End If
  615.         s$ = Dir("")
  616.     Wend
  617. End Proc
  618.  
  619. Dim fname$(40)
  620. Dim bAll%
  621.  
  622. '--------------------------------------------------------
  623. ' Add Log File
  624. '--------------------------------------------------------
  625. Proc AddLogFile(add$, subj$)
  626.     Dim fp%
  627.     Dim s$
  628.     s$ = Space(256)
  629.     fp = FOpen(.HomePath + SENTMAIL_LOG, "w")
  630.     FSeek(fp, 0, 1)
  631.     wsprintf(s$, "%s %s To:%-30s %s" + Chr(10), Date(), Time("%H:%M"), add$, subj$)
  632.     FPuts(fp, s$)
  633.     FClose(fp)
  634. End Proc
  635.  
  636. '--------------------------------------------------------
  637. ' Receive All Mail in Server
  638. '--------------------------------------------------------
  639. Proc ReceiveAll()
  640.     bAll = True
  641.     Receive()
  642.     bAll = False
  643. End Proc
  644.  
  645. '--------------------------------------------------------
  646. ' Receive Unread Mail
  647. '--------------------------------------------------------
  648. Proc Receive()
  649.     Dim buf$
  650.     Dim stat$
  651.     Dim nRC%
  652.     Dim recv$
  653.     buf$ = Space$(2048)
  654.     stat$ = Space$(256)
  655.     If MailInit() Then
  656.         If StartReceiveSession() Then
  657.             nCnt = 0
  658.             nNewCnt = 0
  659.             If hRecvMenu <> 0 Then
  660.                 DiscardMenu(hRecvMenu)
  661.             End If
  662.             hRecvMenu = NewMenu()
  663.             Dim nBytes%
  664.             nBytes = ListMail(buf$, stat$)
  665.             While nBytes
  666.                 nCnt = nCnt + 1
  667.                 If InStr(stat$, "R") = 0 Or bAll Then
  668.                     fname$(nCnt) = TmpName(inbox$)
  669.                     FileOpen(fname$(nCnt))
  670.                     If .TotLine > 1 Then
  671.                         MsgBox("Too much mail!")
  672.                         Exit While
  673.                     End If
  674.                     .Cols = 256
  675.                     AddMenuItem(hRecvMenu, "&" + buf, nCnt)
  676.                     recv$ = Space(nBytes + 256)        'approximately.
  677.                     GetMail(nCnt, recv$, 0, g_bDel)
  678.                     nNewCnt = nNewCnt + 1
  679.                     DoEvents()
  680.                     SetFocus(.hWnd)            'for Dana's bug
  681.                     InsertString(recv$)
  682.                     Command("TextTop")
  683.                     SaveAs(fname$(nCnt))
  684.                     Delivery()
  685.                     fname$(nCnt) = .PathName
  686.                 End If
  687.                 nBytes = ListMail(buf$, stat$)
  688.             Wend
  689.             recv$ = ""
  690.             EndReceiveSession()
  691.         Else
  692.             MsgBox("Failed to receive" + Chr(10) + GetErrorStatus())
  693.         End If
  694.     End If
  695.  
  696.     If nNewCnt > 1 Then
  697.         nRC = DoMenu(hRecvMenu)
  698.         if (nRC <> -1) Then FileOpen(fname$(nRC))
  699.     Else If nNewCnt = 0 Then
  700.         Dim sNew$
  701.         sNew$ = "No new mail arrived"
  702.         If nCnt Then
  703.             sNew$ = sNew$ + Chr(10) + Str(nCnt) + " read mail on the server"
  704.         End If
  705.         MsgBox(sNew$)
  706.     End If
  707. End Proc
  708.  
  709. '--------------------------------------------------------
  710. ' List of Received Mail
  711. '--------------------------------------------------------
  712. Proc ReceivedMail()
  713.     Dim nRC%
  714.     If hRecvMenu Then
  715.         nRC = DoMenu(hRecvMenu)
  716.         if (nRC <> -1) Then FileOpen(fname$(nRC))
  717.     End If
  718. End Proc
  719.  
  720. '--------------------------------------------------------
  721. ' Compose Reply Mail
  722. '--------------------------------------------------------
  723. Proc Reply()
  724.     Dim add$, subj$, cc$, content$
  725.     Dim nRC%
  726.     Silent()
  727.     Command("SelectAll")
  728.     content$ = GetSelected()
  729.     SelectCancel()
  730.     GotoThere(1,1)
  731.     NoSilent()
  732.     Refresh()
  733.     Dim hLine%
  734.     Dim sLine$
  735.     Dim n%, nIdx%, s$
  736.     Dim sArr$(4)
  737.     Dim I%
  738.     For I = 1 To 4
  739.         sArr$(I) = ""
  740.     Next
  741.     hLine = GetTopLine()
  742.     sLine$ = LoadThisLine(hLine)
  743.     If InStr(sLine$, ":") <> 0 Then
  744.         Do
  745.             n = InStr(sLine$, ":")
  746.             If n Then
  747.                 s$ = Left(sLine$, n-1)
  748.                 Select Case UCase(s$)
  749.                 Case "FROM"
  750.                     nIdx = 1
  751.                 Case "SUBJECT"
  752.                     nIdx = 2
  753.                 Case "CC"
  754.                     nIdx = 3
  755.                 Case "REPLY-TO"
  756.                     nIdx = 4
  757.                 Case Else
  758.                     nIdx = 0
  759.                 End Select
  760.                 If nIdx Then
  761.                     sArr$(nIdx) = Trim(Mid$(sLine$, n + 1))
  762.                 End If
  763.             Else If sLine$ = "" Then
  764.                 Exit Do
  765.             Else
  766.                 If nIdx Then
  767.                     sArr$(nIdx) = sArr$(nIdx) + Trim(sLine$)
  768.                 End If
  769.             End If
  770.             hLine = GetNext(hLine)
  771.             If hLine = 0 Then Exit Do
  772.             sLine$ = LoadThisLine(hLine)
  773.         Loop While True
  774.     End If
  775.     If sArr$(4) <> "" Then        'Reply-To
  776.         add$ = sArr$(4)
  777.     Else
  778.         add$  = sArr$(1)
  779.     End If
  780.     subj$ = "Re:" + sArr$(2)
  781.     cc$   = sArr$(3)
  782.     If add$ = "" Then
  783.         MsgBox("Cannot figure out the address to reply")
  784.         Return
  785.     End If
  786.     n = InStr(content$, Chr(13) + Chr(10) + Chr(13) + Chr(10))
  787.     If n Then
  788.         content$ = Mid(content$, n + 4, Len(content$))
  789.     End If
  790.     FileOpen(TmpName(outbox$))
  791.     SetFocus(.hWnd)
  792.     Silent()
  793.     InsertString(content$)
  794.     Command("SelectAll")
  795.     AddString("> ")
  796.     SelectCancel()
  797.     GotoThere(1,1)
  798.     InsertString("To: " + add$ + Chr(10))
  799.     InsertString("Subject: " + subj$ + Chr(10))
  800.     If cc$ <> "" Then
  801.         InsertString("Cc: " + cc$ + Chr(10))
  802.     End If
  803.     InsertString(Chr(10))
  804.     Command ("TextBot")
  805.     NoSilent()
  806.     Command ("InsertAft")
  807.     Refresh()
  808. End Proc
  809.  
  810. '--------------------------------------------------------
  811. ' Delete Mail Which Have been Read
  812. '--------------------------------------------------------
  813. Proc Delete()
  814.     Dim I%
  815.     Dim buf$
  816.     Dim stat$
  817.     buf$ = Space$(2048)
  818.     stat$ = Space$(256)
  819.     If MsgBox("Deleting all the mail on server" + Chr(10) + "Are you OK?",  "", MB_YESNO) = IDNO Then
  820.         Return
  821.     End If
  822.     MailInit()
  823.     If StartReceiveSession() Then
  824.         I = 0
  825.         While ListMail(buf$, stat$)
  826.             I = I + 1
  827.             If InStr(stat$, "R") = 0 Then
  828.                 If MsgBox(buf$ + Chr(10) + "This mail is unread" + Chr(10) + "Are you sure to delete this?",  "", MB_YESNO | MB_DEFBUTTON2) = IDYES Then
  829.                     If DeleteMail(I) = False Then
  830.                         MsgBox("Failed to delete" + Chr(10) + GetErrorStatus())
  831.                         EndReceiveSession()
  832.                         Return
  833.                     End If
  834.                 End If
  835.             Else If DeleteMail(I) = False Then
  836.                 MsgBox("Failed to delete" + Chr(10) + GetErrorStatus())
  837.                 EndReceiveSession()
  838.                 Return
  839.             End If
  840.         Wend
  841.         EndReceiveSession()
  842.     End If
  843. End Proc
  844.  
  845. '////////////////////////////////////////////////////////////////
  846. ' Sub routines
  847.  
  848. Proc UpdateConfig()
  849.     Dim sDel$
  850.     sDel = "  "
  851.     GetConfiguration(g_ini$, g_name$, g_add$, g_login$, g_pop$, g_smtp$, sDel$)
  852.     g_bDel = Val(sDel$)
  853. End Proc
  854.  
  855. '--------------------------------------------------------
  856. ' Delivery Received Mail
  857. '--------------------------------------------------------
  858. Proc Delivery()
  859.     Dim fp%
  860.     Dim s$
  861.     Dim n1%, n2%, i%, nC%
  862.     Dim head$, sch$, fold$
  863.     fp = FOpen(.HomePath + MAILDELI_DAT, "r")
  864.     If fp = 0 Then Return
  865.     s$ = FGets(fp)
  866.     Do
  867.         s$ = Trim(Left(s$, Len(s$)-1))
  868.         If Left(s$, 1) <> "#" And s$ <> "" Then
  869.             i = 0
  870.             n1 = 0
  871.             n2 = 0
  872.             Do
  873.                 nC = LodB(s$, i)
  874.                 If nC = &H09 Then
  875.                     If n1 = 0 Then
  876.                         n1 = i
  877.                     Else If n2 = 0 Then
  878.                         n2 = i
  879.                         Exit Do
  880.                     End If
  881.                 End If
  882.                 i = i+1;
  883.             Loop While nC
  884.             If n1 And n2 Then
  885.                 head$ = Left(s$, n1)
  886.                 sch$  = Mid(s$, n1+2, n2 - (n1+1))
  887.                 fold$ = Mid(s$, n2 + 2)
  888.             End If
  889.             If head$ <> "" And sch$ <> "" And fold$ <> "" Then
  890.                 Dim hLine%
  891.                 Dim sLine$
  892.                 Dim sHead$
  893.                 sLine$ = ""
  894.                 sHead$ = ""
  895.                 hLine = GetTopLine()
  896.                 While hLine
  897.                     sLine$ = Trim(LoadThisLine(hLine))
  898.                     If sLine$ = "" Then Exit While
  899.                     i = InStr(sLine$, ":")
  900.                     If i <> 0 Or (i = 0 And sHead$ <> "") Then
  901.                         If i <> 0 Then 
  902.                             sHead$ = Left(sLine$, i-1)
  903.                             sLine$ = Mid(sLine$, i+1)
  904.                         End If
  905.                         If UCase(sHead$) = UCase(head$) Then
  906.                             n1 = InStr(sLine$, sch$)
  907.                             If n1 Then
  908.                                 Dim sSave$
  909.                                 sSave$ = inbox$ + fold$
  910.                                 CreateDirectory(sSave$, 0)
  911.                                 FKill(.PathName)
  912.                                 SaveAs(sSave$ + "\" + .FileName)
  913.                                 Return
  914.                             End If
  915.                         End If
  916.                     End If
  917.                     hLine = GetNext(hLine)
  918.                 Wend
  919.             End If
  920.         End If
  921.         s$ = FGets(fp)
  922.     Loop While s$ <> ""
  923.     FClose(fp)
  924. End Proc
  925.  
  926. '--------------------------------------------------------
  927. ' Save to Outbox
  928. '--------------------------------------------------------
  929. Proc SaveAsOutMail(add$, cc$, bcc$, subj$, content$, bOutBox%) As String
  930.     Dim outdir$
  931.     Dim fp%
  932.     Dim s$
  933.     If bOutBox Then
  934.         s$ = TmpName(outbox$)
  935.     Else
  936.         s$ = TmpName(outbox$ + "sent\")
  937.     End If
  938.     fp = FOpen(s$, "w")
  939.     If fp Then
  940.         FPuts(fp, "To:" + add$ + Chr(10))
  941.         FPuts(fp, "Cc:" + cc$ + Chr(10))
  942.         FPuts(fp, "Bcc:" + bcc$ + Chr(10))
  943.         FPuts(fp, "Subject:" + subj$ + Chr(10) + Chr(10))
  944.         Dim cr%
  945.         Dim w$
  946.         Dim nLen%
  947.         nLen = Len(content$)
  948.         Do
  949.             cr% = InStr(content$, Chr(13))
  950.             If cr Then
  951.                 w$ = Left(content$, cr-1) + Chr(10)
  952.                 content$ = Mid$(content$, cr+2, nLen)
  953.             Else
  954.                 w$ = content$ + Chr(10)
  955.                 content$ = ""
  956.             End If
  957.             FPuts(fp, w$)
  958.         Loop While content$ <> ""
  959.         FClose(fp)
  960.     Else
  961.         MsgBox("Cannot open OutBox")
  962.     End If
  963.     Return s$
  964. End Proc
  965.  
  966. '--------------------------------------------------------
  967. ' Get Unique Temporary File Name
  968. '--------------------------------------------------------
  969. Dim nTmpCnt%
  970.  
  971. Proc TmpName(dirname$) As String
  972.     Dim s$
  973.     Do
  974.         s$ = Date("%m%d%H%M") + "." + Hex$(nTmpCnt)
  975.         nTmpCnt = nTmpCnt + 1
  976.         If nTmpCnt >= &H1000 Then nTmpCnt = 0
  977.         s$ = dirname$ + s$
  978.     Loop While Dir$(s$) <> ""
  979.     Return s$
  980. End Proc
  981.  
  982. '--------------------------------------------------------
  983. ' Get Signature Text
  984. '--------------------------------------------------------
  985. Proc GetSignature() As String
  986.     Dim s$
  987.     Dim sig$
  988.     Dim fp%
  989.     sig$ = Chr(13) + Chr(10)
  990.     fp = FOpen(.HomePath + SIGNATURE_TXT, "r")
  991.     If fp Then
  992.         s$ = FGets(fp)
  993.         While s$ <> ""
  994.             s$ = Left(s$, Len(s$) -1)
  995.             sig$ = sig$ + s$ + Chr(13) + Chr(10)
  996.             s$ = FGets(fp)
  997.         Wend
  998.     End If
  999.     If sig$ = Chr(13) + Chr(10) Then
  1000.         sig$ = ""
  1001.     End If
  1002.     Return sig$
  1003. End Proc
  1004.  
  1005.