Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/vbccmail/smtpsend.bas

BASIC Source File | 1998-01-16 | 28.7 KB | 1,067 lines

Attribute VB_Name = "smtpsend"
Option Explicit




' stuff for smtp client
  Dim linenumber As Long

Dim BSMTPfiles() As String
Dim NoofBSMTPfiles As Integer
Dim CurrentBSMTPfile As Integer
Dim ImACTIVE As Boolean
Dim Timeout As Integer
Dim tryingtoconnect As Boolean
Dim SENDfilefh As Integer
Dim SENDDATAeofflag As Boolean
Dim sendingfile As Boolean
Dim lastCommand As String
Dim returnerror As String
Dim failedaddresses As Integer
Dim addressfailurelist As String
Dim imconnected As Boolean

Global MAXto As Integer

Global ADDRESSto() As String
Global ADDRESSfrom As String






Dim SendingDomain As String ' from helo
Dim cTO As Integer
Public sendmailtimer As Integer
Const MYINTERNETSERVER = "192.168.0.101"
Const SMTPTCPPORT = 25 ''' assigned TCP contact port */
Const SMTPGREET = "220"  '' SMTP successful greeting */
Const SMTPOK = "250" '' SMTP OK code */
Const SMTPREADY = "354"  '' SMTP ready for data */
Const SMTPSOFTFATAL = "421" '' SMTP soft fatal code */
Const SMTPHARDERROR = "554" '' SMTP miscellaneous hard failure */
Const OUR_DOMAIN = "ntuucp.envision-design.com.hk"
'stuff for uucp

Private Type rcptaddr
  address As String
  addrtype As String
  name As String
  domain As String
End Type
Dim sMailFrom As String
Dim errorexist As Boolean
Dim sRcpt() As rcptaddr
Dim iRcptCnt As Integer
Const WAITING_FOR_ADDRESSES = 1
Const WAITING_FOR_MESSAGE = 2








'Sub InitializeClient()
'  sendingfile = False
'  ImACTIVE = False
'  SENDfilefh = -1
'  sendmailtimer = mailserver.SENDMAILINTERVAL
'End Sub




'Sub BSMTPstartup()
'  Dim tempfilename As String
'  ReDim BSMTPfiles(1)
'  Form1.List1.AddItem "Checking the outgoing files"
'  NoofBSMTPfiles = 0
'  tempfilename = Dir(mailserver.DEF_NET_DIR & "*.*")
'  If tempfilename = "" Then
'    ImACTIVE = False
'    Form1.List1.AddItem "No Files to process - Closing"
'    Exit Sub
'  End If
'  BSMTPfiles(1) = mailserver.DEF_NET_DIR & tempfilename
'  NoofBSMTPfiles = 1
'  tempfilename = Dir
'  Do While Not tempfilename = ""
'    NoofBSMTPfiles = NoofBSMTPfiles + 1
'    ReDim Preserve BSMTPfiles(NoofBSMTPfiles)
'    BSMTPfiles(NoofBSMTPfiles) = mailserver.DEF_NET_DIR & tempfilename
'    tempfilename = Dir
'  Loop
'  CurrentBSMTPfile = 1
'  doPARSE
'End Sub



'Sub doPARSE() ' reads a bsmtp file and turns it into a smtp out file
'
'  Dim words() As String
'  Dim nowords As Integer
'  Dim buf As String
'
'  Form1.List1.AddItem "Parsing " & CurrentBSMTPfile
'open_file:
'  On Error GoTo failtoopen
'  SENDfilefh = FreeFile
'  Open BSMTPfiles(CurrentBSMTPfile) For Input As #SENDfilefh
'  On Error GoTo 0
'
'init_state:
'  If EOF(SENDfilefh) Then
'    GoTo seen_QUIT
'  End If
'  Line Input #SENDfilefh, buf
'  nowords = split(buf, words)
'
'  If nowords = 0 Then
'    GoTo init_state ''NOT VERY FORGIVING!
'  End If
'  Select Case UCase(words(1))
'    Case "HELO"
'      If nowords > 1 Then
'        SendingDomain = words(2)
'      Else
'        SendingDomain = OUR_DOMAIN
'      End If
'      MAXto = 0
'      ReDim ADDRESSto(1)
'      GoTo seen_HELO
'    Case Else
'      GoTo init_state
'  End Select
'
'seen_HELO:
'  If EOF(SENDfilefh) Then
'    GoTo seen_QUIT
'  End If
'  Line Input #SENDfilefh, buf
'  nowords = split(buf, words)
'
'  If nowords = 0 Then
'    GoTo seen_HELO
'  End If
'  Select Case UCase(words(1))
'    Case "MAIL"
'    Form1.List1.AddItem "MAIL: w2=" & words(2)
'      If Trim(UCase(words(2))) = "FROM:" Then
'        Form1.List1.AddItem "MAIL: w3=" & words(3)
'        ADDRESSfrom = copypath(words(3))
'        GoTo seen_MAIL
'      Else
'        ADDRESSfrom = copypath(Mid(words(2), 6))
'        GoTo seen_MAIL
'      End If

'    Case "RSET", "QUIT" 'if i get quit somethings gone wrong!
'      GoTo seen_RSET
'    Case Else
'      Form1.List1.AddItem "OOOPS, GOT " & buf
'      GoTo seen_HELO
'  End Select
'
'seen_MAIL:

'  If EOF(SENDfilefh) Then
'    GoTo seen_QUIT
'  End If
'  Line Input #SENDfilefh, buf
'
'  nowords = split(buf, words)
'  If nowords = 0 Then
'    GoTo seen_HELO
'  End If
'  Select Case UCase(words(1))
'    Case "RCPT"
'Form1.List1.AddItem "TO: w2=" & words(2)
'   If Trim(UCase(words(2))) = "TO:" Then
'   Form1.List1.AddItem "TO: w3=" & words(3)
'
'        addpath words(3)
'        GoTo seen_MAIL
'      Else
'        addpath Mid(words(2), 4)
'        GoTo seen_MAIL
'      End If
'    Case "DATA"
'      GoTo seen_DATA
'    Case "RSET"
'      GoTo seen_RSET
'    Case "MAIL"
'      GoTo seen_MAIL
'    Case "QUIT"
'      GoTo seen_RSET
'    Case Else
'      GoTo seen_MAIL
'  End Select
'
'seen_RSET:
'
'  MAXto = 0
'  ReDim ADDRESSto(1)
'  ADDRESSfrom = ""
'  GoTo seen_HELO
'
'seen_DATA:
'  Form1.List1.AddItem "Got data - processing!"
'
'  domail
'  Exit Sub
'
'seen_QUIT:
'
  ' got eof before data!, kill the file and go to next file!
'  Close #SENDfilefh
'  Kill BSMTPfiles(CurrentBSMTPfile)
'failtoopen:
'  CurrentBSMTPfile = CurrentBSMTPfile + 1
'  If CurrentBSMTPfile > NoofBSMTPfiles Then
'    'there are no more files to read
'    ImACTIVE = False
'    Exit Sub
'  End If
'  MAXto = 0
'  ReDim ADDRESSto(1)
'  ADDRESSfrom = ""
'  GoTo open_file
'
'End Sub



Sub domail()
  If imconnected Then
    doRSET
    Exit Sub
  Else
    doINIT
    Exit Sub
  End If
End Sub



' all routines must check sendmailactive before entering!!!
Sub doINIT()
  Dim test As Variant
  lastCommand = "INIT"
 Form1.List1.AddItem "Connecting to server", 0
' Form1.tcps.Disconnect
  tryingtoconnect = True
  Timeout = 10
  Form1.tcps.LocalPort = 221
  Form1.tcps.HostAddr = "192.168.0.101"
  Form1.tcps.HostPort = 25
  Form1.tcps.LocalPort = 0
  Form1.tcps.Connect
'  Form1.tcps.LocalPort = 221
'  Form1.tcps.Connect
  SENDfilefh = FreeFile
  Open CCMAILWORKINGFOLDER & "SMTPOUT" & ".txt" For Input As #SENDfilefh
  ''debug.print Form1.tcps.Send(vbCrLf)
  ' for now I'm going to assume this will work!!
End Sub


Private Sub SMTPclientTIMER_Timer()
 Dim test As Variant
  Dim ontime As Boolean
  Dim ontoday As Boolean
  Dim numfirstcalltime As Integer
  Dim numlastcalltime As Integer
  Dim numnowtime As Integer
  If Form1.List1.ListCount > 20 Then
    Form1.List1.RemoveItem 0
  End If

  If ImACTIVE Then
    Select Case Timeout
      Case Is > 0
        Timeout = Timeout - 1
      Case 0
        ' if trying to connect then do a dial and
        If tryingtoconnect Then
          tryingtoconnect = False
          Form1.List1.AddItem "Trying to start RAS", 0
          test = Shell("C:\winnt\system32\RASPHONE.exe -D SUPERNET", 1)
          Timeout = -1
          sendmailtimer = 25 ' will try again in 25 seconds
        End If
        'debug.print "Closing "; Form1.tcps.Close
        If SENDfilefh > 0 Then
          Close #SENDfilefh
        End If
        ImACTIVE = False
        Exit Sub
    End Select
    'Socket errors
    Me.Caption = "Timeout in " & Timeout & " seconds "
   ' Select Case Form1.tcps.state
  '    Case 0, 8 ' Closed, Closed by server, error
 '       Form1.List1.AddItem "Closed by server or error"
'        If SENDfilefh > 0 Then'
          'Close #SENDfilefh
'        End If'
'        ImACTIVE = False
'        Exit Sub
'      Case 9
'        Form1.List1.AddItem "Closed by me??"
'        Form1.tcps.Close
'        If SENDfilefh > 0 Then
'          Close #SENDfilefh
'        End If
'        ImACTIVE = False
'        Exit Sub
'    End Select
  Else

    ' check call times and days
    ' if it is off set sendmailtimer to -1

  ' MyDate represents a Wednesday.
    If UCase(Mid(mailserver.calldays, WeekDay(Now), 1)) = Mid(mailserver.calldays, WeekDay(Now), 1) Then
       ontoday = True
    Else
       ontoday = False
    End If
    numfirstcalltime = Val(Left(mailserver.firstcalltime, InStr(mailserver.firstcalltime, ":") - 1)) * 60 + Val(Mid(mailserver.firstcalltime, InStr(mailserver.firstcalltime, ":") + 1))
    numlastcalltime = Val(Left(mailserver.lastcalltime, InStr(mailserver.lastcalltime, ":") - 1)) * 60 + Val(Mid(mailserver.lastcalltime, InStr(mailserver.lastcalltime, ":") + 1))
    numnowtime = Val(Format(Now, "hh")) * 60 + Val(Format(Now, "nn"))
    If numnowtime > numfirstcalltime And numnowtime < numlastcalltime Then
      ontime = True
    Else
      ontime = False
    End If

    If sendmailtimer > 5 And (Not ontime Or Not ontoday) Then
      sendmailtimer = -1
       mailserver.cbtimer.Caption = "OFF"
     mailserver.cbtimer.value = 0
      Me.Caption = "SMTP Client Off"

    Else
      If sendmailtimer < 0 And ontime And ontoday Then
        sendmailtimer = mailserver.SENDMAILINTERVAL
      mailserver.cbtimer.Caption = "ON"
      mailserver.cbtimer.value = 1


      End If
    End If
    Select Case sendmailtimer
      Case Is > 0
        sendmailtimer = sendmailtimer - 1
        Me.Caption = "Sending Mail in " & sendmailtimer & " seconds"
      Case 0

        sendmailtimer = mailserver.SENDMAILINTERVAL
        ImACTIVE = True
        Checkuucpdir ' not event driven
 '       Redirectmail



 If mailserver.cbtimer.value = 1 Then
        BSMTPstartup ' event driven
  End If
    End Select
  End If
End Sub



'smtp incomming - used by incomming data and
'intermitant utils to process all commands....

Sub SMTP_incoming(reply As String)

  Form1.List1.AddItem "S:" & reply, 0
  Select Case lastCommand
    Case "INIT"
      If Not Left(reply, 3) = SMTPGREET Then
        returnerror = reply
        doQUIT
        Exit Sub
      End If
      doHELO
      Exit Sub
    Case "HELO"
      If Not Left(reply, 3) = SMTPOK Then
        returnerror = reply
        doQUIT
        Exit Sub
      End If
      doRSET
      Exit Sub
    Case "RSET"
      If Not Left(reply, 3) = SMTPOK Then
        returnerror = reply
        lastCommand = "QUIT"
        doQUIT
        Exit Sub
      End If
      doFROM
      Exit Sub
    Case "FROM"
      If Not Left(reply, 3) = SMTPOK Then
        doQUIT
        Exit Sub
      End If
      'send the first address!
      addressfailurelist = ""
      failedaddresses = 0
      cTO = 1
      doTO 1
      Exit Sub
    Case "TO"
      If Not Left(reply, 3) = SMTPOK Then
      '*** will need to change this later???
        addressfailurelist = reply & vbCrLf
        failedaddresses = failedaddresses + 1
      End If
      cTO = cTO + 1
      If Not cTO > MAXto Then
        doTO cTO
        Exit Sub
      End If
      If MAXto = failedaddresses Then
        doNEXTfile
        Exit Sub
      End If
      doDATA
      Exit Sub

    Case "DATA"
      If Not Left(reply, 3) = SMTPREADY Then 'IS this ok, ready to send
        lastCommand = "QUIT"
        doQUIT
        Exit Sub
      End If
      doSENDDATA
      Exit Sub

    Case "SENDDATA"
      If Not Left(reply, 3) = SMTPOK Then
      '*** IS THIS THE RETURN CODE FOR DATA SENT OK!
        doQUIT
        Exit Sub
      End If
      doNEXTfile
      Exit Sub
    Case "QUIT"
      'this is where it closes the connection

     Form1.tcps.Disconnect
      Form1.List1.AddItem "closed connection", 0
      ImACTIVE = False
    Case Else
      MsgBox "OOPS COCKED UP SOMEWHERE"
      End
  End Select

End Sub


Sub doNEXTfile()
  If SENDfilefh > -1 Then
    Close #SENDfilefh
  End If
  If failedaddresses > 0 Then
    doSENDERROR
    'add error message to users file!!
  End If

  MAXto = 0
  ReDim ADDRESSto(1)
  ADDRESSfrom = ""
  If CurrentBSMTPfile > NoofBSMTPfiles Then
    'there are no more files to read
    doQUIT
    Exit Sub
  End If
  Form1.tcps.Disconnect
  sendingmail = False
End Sub

Sub doHELO()
   lastCommand = "HELO"

   Form1.tcps.SendData "HELO " & OUR_DOMAIN & vbCrLf, Len("HELO " & OUR_DOMAIN) + 2

       Form1.List1.AddItem "C: HELO " & OUR_DOMAIN
End Sub

Sub doRSET()
   lastCommand = "RSET"
      If Form1.tcps.Send("RSET" & vbCrLf) < 0 Then
     'debug.print "error sending data"
    End If

   Form1.List1.AddItem "C:RSET", 0
End Sub

Sub doFROM()
   lastCommand = "FROM"
  If Form1.tcps.Send("MAIL FROM: <" & ADDRESSfrom & ">" & vbCrLf) < 0 Then
     'debug.print "error sending data"
  End If
   Form1.List1.AddItem "C:MAIL FROM: <" & ADDRESSfrom & ">", 0
End Sub

Sub doTO(i As Integer)
  lastCommand = "TO"
If Form1.tcps.Send("RCPT TO: <" & ADDRESSto(i) & ">" & vbCrLf) < 0 Then
     'debug.print "error sending data"
  End If
   Form1.List1.AddItem "C:RCPT TO: <" & ADDRESSto(i) & ">", 0
End Sub


Sub doNOOP()
  lastCommand = "NOOP"
  If Form1.tcps.Send("NOOP" & vbCrLf) < 0 Then
     'debug.print "error sending data"
  End If

  Form1.List1.AddItem "C:NOOP", 0
End Sub



Sub doDATA()
  lastCommand = "DATA"
  If Form1.tcps.Send("DATA" & vbCrLf) < 0 Then
       'debug.print "error sending data"
  End If

  Form1.List1.AddItem "C:DATA", 0
End Sub


Sub doQUIT()
   lastCommand = "QUIT"
   Form1.tcps.Send ("QUIT" & vbCrLf)


   Form1.List1.AddItem "C:QUIT", 0
End Sub

Sub doSENDDATA()
  linenumber = 0
  lastCommand = "SENDINGDATA"
' just add the header bit on and send out file until eof or "."
  Dim buf As String

  If Form1.tcps.Send("Received: ") < 0 Then
       'debug.print "error sending data"
  End If

  If Not SendingDomain = "" Then
    If Form1.tcps.Send("from " & SendingDomain & " ") < 0 Then
           'debug.print "error sending data"
  End If

  End If
  If Not OUR_DOMAIN = "" Then
    If Form1.tcps.Send("by " & OUR_DOMAIN & " ") < 0 Then
           'debug.print "error sending data"
  End If

  End If
  If Not ADDRESSfrom = "" Then
    If Form1.tcps.Send("for " & ADDRESSfrom & " ") < 0 Then
         'debug.print "error sending data"
  End If

  End If
  If Form1.tcps.Send("with BSMTP basic(1.0);" & vbCrLf & "  " & Format(Now, "ddd, d mmm yy hh:nn:ss +08:00") & vbCrLf) < 0 Then
         'debug.print "error sending data"
  End If



  sendingfile = True
  Do While sendingfile = True
    sendaline
    DoEvents
  Loop
End Sub

Sub sendaline()
  Dim buf As String

  On Error GoTo SendDataeof
  If EOF(SENDfilefh) Then
    GoTo SendDataeof
  End If
  Line Input #SENDfilefh, buf
  If buf = "." Then
    GoTo SendDataeof
  End If
  If Form1.tcps.Send(buf & vbCrLf) < 0 Then
           'debug.print "error sending data"
  End If

  linenumber = linenumber + 1
  Form1.Caption = "Sending line - " & linenumber
  Exit Sub

SendDataeof:
  On Error GoTo 0
  Close #SENDfilefh
  sendingfile = False
  If Form1.tcps.Send("." & vbCrLf) < 0 Then
         'debug.print "error sending data"
  End If

  Form1.List1.AddItem "C: Message Sent", 0
  lastCommand = "SENDDATA"
  SENDDATAeofflag = True
  SENDfilefh = -1
  Timeout = 300
End Sub

Sub doSENDERROR()
  Dim errorfile As String
  Dim errorfh As Integer
  Dim buf As String
  Dim username As String
  username = Left(ADDRESSfrom, InStr(ADDRESSfrom, "@") - 1)

  If Dir(mailserver.DEF_POP3_DIR & username, vbDirectory) = "" Then
    MkDir mailserver.DEF_POP3_DIR & username
  End If
  errorfh = FreeFile
  errorfile = getnewfilename(mailserver.DEF_POP3_DIR & username)
  Open errorfile For Output Lock Read Write As #errorfh
  Print #errorfh, "HELO " & OUR_DOMAIN
  Print #errorfh, "MAIL FROM: <>"
  Print #errorfh, "RCPT TO: <" & ADDRESSfrom & ">"
  Print #errorfh, "DATA"
  Print #errorfh, "To: " & ADDRESSfrom
  Print #errorfh, "From: postmaster@" & OUR_DOMAIN
  Print #errorfh, "Subject: Error Sending Mail to Internet"
  Print #errorfh, ""
  Print #errorfh, "--------------------------------------------------"
  Print #errorfh, "ERRORS"
  Print #errorfh, "--------------------------------------------------"
  Print #errorfh, addressfailurelist
  Print #errorfh, "--------------------------------------------------"
  Print #errorfh, "MESSAGE"
  Print #errorfh, "--------------------------------------------------"
  SENDfilefh = FreeFile
  Open BSMTPfiles(CurrentBSMTPfile) For Input As #SENDfilefh
  Do While Not EOF(SENDfilefh)
    Line Input #SENDfilefh, buf
    If UCase(Left(buf, 4)) = "DATA" Then
      Exit Do
    End If
  Loop
  Do While Not EOF(SENDfilefh)
    Line Input #SENDfilefh, buf
    Print #errorfh, buf
  Loop
  Close #SENDfilefh
  Close #errorfh

End Sub



''BSMTP CODE ---------------------------------------------------


Function copypath(s As String) As String
  Dim rval As String
  If s = "" Then
    copypath = ""
    Exit Function
  End If

  If InStr(s, "<") = 0 Then
    rval = s
  Else
    rval = Mid(s, (InStr(s, "<") + 1))
  End If
  If InStr(rval, ">") > 0 Then
    rval = Left(rval, (InStr(rval, ">") - 1))
  End If
  Form1.List1.AddItem "added address : " & rval, 0
  copypath = rval
End Function

Function split(s As String, ByRef strarray() As String) As Integer
  Dim buf As String
  Dim nvecs As Integer
  Dim slen As Integer
  Dim sp As Integer
  Dim lastp As String
  ReDim strarray(1)

  If s = "" Then
    split = 0
    Exit Function
  End If
  slen = Len(Trim(s))
  buf = Trim(s)
  nvecs = 0
  lastp = ""
  For sp = 1 To slen
    If Mid(buf, sp, 1) = " " Then
      nvecs = nvecs + 1
      ReDim Preserve strarray(nvecs)
      strarray(nvecs) = lastp
      lastp = ""
    End If
    If Asc(Mid(buf, sp, 1)) > 31 Then
      lastp = lastp & Mid(buf, sp, 1)
    End If
  Next
  nvecs = nvecs + 1
  ReDim Preserve strarray(nvecs)
  strarray(nvecs) = lastp
  split = nvecs
End Function

Sub addpath(s As String)
  If s = "" Then
     Exit Sub
  End If
  MAXto = MAXto + 1
  ReDim Preserve ADDRESSto(MAXto)
  ADDRESSto(MAXto) = copypath(s)
End Sub

Function getnewfilename(directoryname As String) As String
  Dim testfilename As String
  Dim testnumber As Integer
  testnumber = 0
  testfilename = directoryname & "\Vbmail" & Format(Now, "yyyymmddhhnnss")
  Do While Not Dir(testfilename & testnumber) = ""
    testnumber = testnumber + 1
  Loop
  getnewfilename = testfilename & testnumber
End Function




'Sub Checkuucpdir()
'  Dim Current_addressfile As String
'
'  Dim astring As String
'  Dim currentstate As Integer
'  Dim udirfh As Integer
'  Dim xfilename As String
'  Dim dfilename As String
'  Dim i As Long
'  Dim xfiles() As String
'  ReDim xfiles(0)
'  Form1.List1.AddItem "UUCP checking directory", 0
'  DoEvents 'lets makesure its showing!
'
  ' this bit is here to stop continuous looping for failed files!
'  xfilename = Dir(mailserver.UUCP_DIR & "\*.x??")
'  Do While Not xfilename = ""
'    ReDim Preserve xfiles(UBound(xfiles) + 1)
'    xfiles(UBound(xfiles)) = xfilename
'    xfilename = Dir
'  Loop
'

'  For i = 1 To UBound(xfiles)
'    processuucpfiles xfiles(i)
'  Next
  'SHOULD NOT BE ANY NEED TO REMOVE THE D FILES - JUST LEAVE UM THERE!

  ' loop - move all d files left over to unknown
'  Form1.List1.AddItem "found all the x files - cleaning up"
'  dfilename = Dir(mailserver.UUCP_DIR & "\*.d??")
'  Do While Not dfilename = ""
'    If Dir(mailserver.UUCP_DIR & "\UNKNOWN", vbDirectory) = "" Then
'      MkDir mailserver.UUCP_DIR & "\UNKNOWN"
'    End If
'    Name mailserver.UUCP_DIR & "\" & dfilename As mailserver.UUCP_DIR & "\UNKNOWN\" & dfilename
'    dfilename = Dir(mailserver.UUCP_DIR & "\*.d??")
'  Loop
'End Sub

'Sub processuucpfiles(addrfile As String)
'  Dim addfh As Integer, astring As String
'  Dim dfilename As String
'  Dim drealfilename As String
'  Dim ioutfh() As Integer
'  iRcptCnt = 0
'  drealfilename = ""
'  sMailFrom = ""
'  addfh = FreeFile
'  On Error GoTo cantopenfile
 ' Open mailserver.UUCP_DIR & "\" & addrfile For Input As #addfh
'  On Error GoTo uucpfoundeof
'  Do While Not EOF(addfh)
'    Line Input #addfh, astring
'    Select Case UCase(Left(astring, 2))
''      Case "F " ' ASSUME THIS IS CORRECT
 '       dfilename = Trim(Mid(astring, 12))
 '     Case "R "
 '       If InStr(astring, "!") = 0 Then
 '         sMailFrom = ""
 '       Else
 '         'domain = first bit, address = last bit
'          sMailFrom = Trim(Mid(astring, InStr(astring, "!") + 1)) & "@" & Left(Trim(Mid(astring, 3)), InStr(Mid(astring, 3), "!") - 1)'
'        End If'
'      Case "C "
'        astring = Trim(Mid(astring, 9)) ' get rid of 'c rmail '
'        Do While InStr(astring, " ") > 0
'          iRcptCnt = iRcptCnt + 1
'          ReDim Preserve sRcpt(iRcptCnt)
'          sRcpt(iRcptCnt).address = Left(astring, InStr(astring, " ") - 1)
''          astring = Trim(Mid(astring, InStr(astring, " ") + 1))
 '       Loop
 '       iRcptCnt = iRcptCnt + 1
 '       ReDim Preserve sRcpt(iRcptCnt)
 '       sRcpt(iRcptCnt).address = astring
 '   End Select
 ' Loop

'uucpfoundeof:
'  Close #addfh
'  Form1.List1.AddItem "Processing Mail from " & sMailFrom
'
  ' look file the dfilename
'    drealfilename = Dir(mailserver.UUCP_DIR & "\" & dfilename & ".d??")
'  If (Not drealfilename = "") And (Not sRcpt(1).address = "") Then ' must have a recipient & a file!
'    Processmail drealfilename
'    Kill mailserver.UUCP_DIR & "\" & drealfilename
'    If Not Dir(mailserver.UUCP_DIR & "\" & addrfile) = "" Then
'      Kill mailserver.UUCP_DIR & "\" & addrfile ' kill the x file!
'    End If
'  End If
'cantopenfile:
'End Sub

'Sub Processmail(dfile As String)
'  'Messagetypes CCMAIL, SYSTEM, ERROR
'  Dim i As Integer, j As Integer
'  Dim ccmailcheck As String
'  Dim localexist   As Boolean
'  Dim ccmailexist   As Boolean
''  Dim inetexist As Boolean
 '
 ' localexist = False
 ' ccmailexist = False
 ' inetexist = False
 ' For i = 1 To iRcptCnt
 '   sRcpt(i).domain = Trim(Mid(sRcpt(i).address, InStr(sRcpt(i).address, "@") + 1))
 '   sRcpt(i).name = Left(sRcpt(i).address, InStr(sRcpt(i).address, "@") - 1)
 '   sRcpt(i).addrtype = ""
 '   ' email address = [e-mail]
 '   ' how are we going to deal with spaces? = convert them to extra dots!!
 '   If LCase(Right(sRcpt(i).name, 7)) = ".ccmail" And LCase(sRcpt(i).domain) = LCase(OUR_DOMAIN) Then
 '     sRcpt(i).addrtype = "CCMAIL"
 '     ccmailexist = True
 '   Else
 '     If LCase(sRcpt(i).domain) = LCase(OUR_DOMAIN) Then
 ''       ' check for mail redirection
  '      For j = 1 To UBound(redirections)
  '        If LCase(redirections(j).rdFrom) = LCase(sRcpt(i).name) Then
  '           If InStr(redirections(j).rdTo, "@") > 0 Then
  '                  sRcpt(i).domain = Trim(Mid(redirections(j).rdTo, InStr(redirections(j).rdTo, "@") + 1))
  '                  sRcpt(i).name = Left(redirections(j).rdTo, InStr(redirections(j).rdTo, "@") - 1)
  '                  sRcpt(i).addrtype = "INTERNET"
  '                   inetexist = True
'                    Exit For
  '           Else
  '                  If LCase(Right(redirections(j).rdTo, 7)) = ".ccmail" Then
  '                        sRcpt(i).name = redirections(j).rdTo
  '                        sRcpt(i).addrtype = "CCMAIL"
'                          ccmailexist = True
  '                        Exit For
  '                  Else
  '                    If LCase(redirections(j).rdTo) = "trash" Then
  '                          sRcpt(i).name = redirections(j).rdTo
  '                          sRcpt(i).addrtype = "TRASH"
'                      Else
  '                          sRcpt(i).name = redirections(j).rdTo
  '                          sRcpt(i).addrtype = "LOCAL"
'                             localexist = True
  '                    End If
  '                    Exit For
  '               End If
'              End If
  '        End If
  '      Next
'        If sRcpt(i).addrtype = "" Then
  '          sRcpt(i).addrtype = "LOCAL"
  '          localexist = True
  '      End If

  '   Else
  '      sRcpt(i).addrtype = "INTERNET" ' need this cause off ccmail re-routing!
  '      inetexist = True
'     End If
  '  End If
  'Next
'  For i = 1 To iRcptCnt
  'Form1.List1.AddItem "Sending File to " & sRcpt(i).name & "-@-" & sRcpt(i).domain & " of type " & sRcpt(i).addrtype, 0
  'Next
  '

  'If ccmailexist Then
  '  sendtoccmail dfile
  'End If
'  If localexist Then
  '  sendtolocaluser dfile
  'End If
'  If inetexist Then
  '  sendtoinet dfile
  'End If
  '
'  Form1.List1.AddItem "finished sending message from :" & sMailFrom, 0
'E 'nd Sub
'
'Sub sendtolocaluser(datafile As String)
'  Dim iFH As Integer
'  Dim oFH As Integer, astring As String, i As Integer, buf As String
'  Dim newfilename As String
'   ' if the users file exist the append, otherwise copy!
'  For i = 1 To iRcptCnt
'    If sRcpt(i).addrtype = "LOCAL" Then
'''      Form1.List1.AddItem "adding message to user:" & sRcpt(i).name
  '    If Dir(mailserver.DEF_POP3_DIR & sRcpt(i).name, vbDirectory) = "" Then 'users folder doesn't exist!
 '       If Dir(mailserver.DEF_POP3_DIR & "UNKNOWN", vbDirectory) = "" Then
 '         MkDir mailserver.DEF_POP3_DIR & "UNKNOWN"
 '       End If
' 'for the moment we will dump all unknown mail into the unknown mailfolder
  '      newfilename = getnewfilename(mailserver.DEF_POP3_DIR & "UNKNOWN")
  '      Form1.List1.AddItem "could not find user " & sRcpt(i).name & " - adding to UNKNOWN", 0

        ' copy the data file as well
'        sRcpt(I).addrtype = "ERROR : User " & sRcpt(I).name & " Not Known at this Post office"
 '       errorexist = True
  '    Else
       ' check if to file exists, if it does rename this one!
  '      newfilename = getnewfilename(mailserver.DEF_POP3_DIR & sRcpt(i).name)
  '     Form1.List1.AddItem "Adding to userfiles " & newfilename
'
'      End If
        ' must have data at start!!!!
        ' no option here !!
'      oFH = FreeFile
'      Open newfilename For Output As #oFH
'      iFH = FreeFile
'      Open mailserver.UUCP_DIR & "\" & datafile For Input As #iFH
''      Print #oFH, "HELO"
 '     Print #oFH, "MAIL FROM: <" & sMailFrom & ">"
 '     Print #oFH, "RCPT TO: <" & sRcpt(i).name & "@" & sRcpt(i).domain & ">"
 '     Print #oFH, "DATA"
 '     On Error GoTo closethem
 '     Do While Not EOF(iFH)
 '       Line Input #iFH, buf
 '       Print #oFH, buf
 '     Loop
'closethem:
'      On Error GoTo 0
'      Close #iFH
'      Close #oFH
'      Form1.List1.AddItem "Message added to folder", 0
'    End If
'  Next
'End Sub


'Sub sendtoccmail(datafile As String)
'  Dim iFH As Integer
'  Dim oFH As Integer, astring As String, i As Integer, buf As String
'  Dim newfilename As String
'   ' if the users file exist the append, otherwise copy!
'
'  newfilename = getnewfilename(mailserver.ccMAILspoolDIR)
'    Form1.List1.AddItem "Adding to ccmail  folder" & mailserver.ccMAILspoolDIR, 0
'  oFH = FreeFile
'  Open newfilename For Output As #oFH
''  iFH = FreeFile
 ' Open mailserver.UUCP_DIR & "\" & datafile For Input As #iFH
 ' Print #oFH, "HELO"
 ' Print #oFH, "MAIL FROM: <" & sMailFrom & ">"
 ' For i = 1 To iRcptCnt
 '     If sRcpt(i).addrtype = "CCMAIL" Then
 '       Print #oFH, "RCPT TO: <" & sRcpt(i).name & "@" & sRcpt(i).domain & ">"
 '     End If
'  Next
 ' Print #oFH, "DATA"
'  On Error GoTo closethem
'  Do While Not EOF(iFH)
'     Line Input #iFH, buf
'     Print #oFH, buf
'  Loop
'closethem:
'  On Error GoTo 0
'  Close #iFH
'  Close #oFH
'  Form1.List1.AddItem "Message added to folder", 0
'
'
'End Sub


'Sub sendtoinet(datafile As String)
'  Dim iFH As Integer
'  Dim oFH As Integer, astring As String, i As Integer, buf As String
'  Dim newfilename As String
'   ' if the users file exist the append, otherwise copy!
'
'   If Dir(mailserver.DEF_NET_DIR, vbDirectory) = "" Then 'net folderdoesn't exist!
'     If Dir(mailserver.DEF_POP3_DIR & "UNKNOWN", vbDirectory) = "" Then
'       MkDir mailserver.DEF_POP3_DIR & "UNKNOWN"
'     End If
'     newfilename = getnewfilename(mailserver.DEF_POP3_DIR & "UNKNOWN")
'     Form1.List1.AddItem "could not find net folder  - adding to UNKNOWN", 0
'  Else
'     newfilename = getnewfilename(mailserver.DEF_NET_DIR)
'    Form1.List1.AddItem "Adding to net folder" & mailserver.DEF_NET_DIR
'  End If
'  oFH = FreeFile
'  Open newfilename For Output As #oFH
'  iFH = FreeFile
'  Open mailserver.UUCP_DIR & "\" & datafile For Input As #iFH
'  Print #oFH, "HELO"
'  Print #oFH, "MAIL FROM:<" & sMailFrom & ">"
'  For i = 1 To iRcptCnt
'      If sRcpt(i).addrtype = "INTERNET" Then
'        Print #oFH, "RCPT TO:<" & sRcpt(i).name & "@" & sRcpt(i).domain & ">"
'      End If
'  Next
'  Print #oFH, "DATA"
'  On Error GoTo closethem
'  Do While Not EOF(iFH)
'     Line Input #iFH, buf
'     Print #oFH, buf
'  Loop
''closethem:
 ' On Error GoTo 0
 ' Close #iFH
 ' Close #oFH
 ' Form1.List1.AddItem "Message added to folder"
'
'End Sub



Private Sub tcpSMTPclient_DataReceived(ByVal data As String, ByVal l As Long)
  tryingtoconnect = False
  Timeout = -1
  Dim reply As String

  SMTP_incoming data
End Sub