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

BASIC Source File | 1998-02-18 | 45.0 KB | 1,427 lines

Attribute VB_Name = "CCmail_to_smtp"
Option Explicit

#Const fullrun = True

Global GMToffset As String
Global LocalPO As String
Global GatewayPO As String
Global CCMAILpassword As String
Global CCMAILpodir As String
Global CCMAILEXPORTFOLDER As String
Global CCMAILEXPORTprognFOLDER As String
Global CCMAILWORKINGFOLDER As String
Global CCERRORDIR As String

Global CCMAILTEMPFILE As String
Global inetDOMAIN  As String
Global DEFAULTfromADDRESS  As String
Global DEFAULTfromUSER As String

Global sendingmail    As Boolean
'----------------------
'GPL (C) Alan Knowles 1998

Dim Globalsequence As Long
Type ccADDRESS
  Post_office As String
  name As String
End Type

Dim TextItems() As tyTextItem
Dim FileItems() As String

Type tyTextItem
  Title As String
  Body As String
End Type

Type ccMESSAGE
  MAILfrom As ccADDRESS
  Forwardedby As ccADDRESS
  DateofMessage As Date
  mailto() As ccADDRESS
  mailcc() As ccADDRESS
  mailbcc() As ccADDRESS
  mailalsoto() As ccADDRESS
  mailalsocc() As ccADDRESS
  Priority As String
  subject As String
  RRQ As Boolean
  RRT As Boolean
  Notdeliverableto() As ccADDRESS
End Type

Dim boundary As String
Dim message As ccMESSAGE
Dim ismime As Boolean


Sub ccMail_Gateway_Main()
' revised version
' this one gets the mail then sends it!


  Dim i As Long
  Dim j As Long
  Dim importfilename As String
  Globalsequence = 1
  Dim messageids() As String
   'debug.print
   Debug.Print ccexport_summary(messageids())

  For i = 1 To UBound(messageids)
      Form1.List1.AddItem "[" & Format(Now, "hh:nn") & " CCEXPORT]  Reading MSG#" & messageids(i), 0
    ccexport_file messageids(i)

    readccfile
    createsmtpfile ' USES THE SMTPSEND TO SEND A FILE!
#If fullrun Then
     Kill CCMAILTEMPFILE & "1"
#Else
   'debug.print "Killing "; CCMAILTEMPFILE
#End If


     For j = 0 To UBound(FileItems)
            If Not FileItems(j) = "" Then
  #If fullrun Then
                  If Not Dir(CCMAILEXPORTFOLDER & FileItems(j)) = "" Then
                    Kill CCMAILEXPORTFOLDER & FileItems(j)
                 End If
#End If
                'debug.print "killing attachment : "; FileItems(j)

            End If
    Next

  Next


  ' GRAB MESSAGES FROM CCSPOOL FOLDER & PROCESS!

 ' ReDim messageids(0)
'  messageids(0) = Dir(CCMAILSPOOLFOLDER & "*.*")'
  'Do While Not messageids(UBound(messageids)) = "" '
'      ReDim Preserve messageids(UBound(messageids') + 1)
'      messageids(UBound(messageids)) = Dir
'  Loop
'  For i = 0 To UBound(messageids) - 1
'   'debug.print "parsing :"; messageids(i)
'      parse_smtp messageids(i)
'      importfilename = Create_ccimport_file()
'      If Not ccimport_file(importfilename) Then
'        FileCopy CCMAILSPOOLFOLDER & messageids(i), CCMAILEXPORTFOLDER & "probs\" & messageids(i)
'     End If
'
'      If Not Dir(importfilename) = "" Then
'        Kill importfilename
'      End If
'
'      'debug.print "killing "; importfilename
'
'
'      For j = 1 To UBound(FileItems)
'        If Not FileItems(j) = "" Then
'#If fullrun Then
'          Kill FileItems(j)
'#Else
'          'debug.print "Killing attached file "; FileItems(j)
'#End If
'        End If


'      Next
'#If fullrun Then
'          Kill CCMAILSPOOLFOLDER & messageids(i)
'#End If
'          'debug.print "Killing import file "; CCMAILSPOOLFOLDER & messageids(i)



'  Next

End Sub


Sub Clearmessage()
  ReDim TextItems(0)
  ReDim FileItems(0)
  With message
 .MAILfrom.Post_office = ""
 .MAILfrom.name = ""

    .Forwardedby.Post_office = ""
    .Forwardedby.name = ""
    .DateofMessage = Now
    ReDim .mailto(0)
    ReDim .mailcc(0)
    ReDim .mailbcc(0)
    ReDim .mailalsoto(0)
    ReDim .mailalsocc(0)
    .Priority = ""
    .subject = "No Subject"
    .RRQ = False
    .RRT = False
    ReDim .Notdeliverableto(0)
  End With
  TextItems(0).Body = ""
  ismime = False
End Sub











Sub readccfile()
  Dim messagelength As Long
  Dim contentlength As Long
  Dim currentpartlength As Long
  Dim isenvelope As Boolean
  Dim buf As String
  Dim firstword As String
  Dim thefileFH As Integer
  Dim tempstring As String
  Dim textbodyflag As Boolean
  Clearmessage

  thefileFH = FreeFile
  Open CCMAILTEMPFILE & "1" For Input As #thefileFH

  isenvelope = True
  Do While isenvelope
    If EOF(thefileFH) Then
      Exit Do
    End If
    Line Input #thefileFH, buf
    If InStr(Trim(buf), " ") > 0 Then
      firstword = Left(Trim(buf), InStr(Trim(buf), " ") - 1)
    Else
      firstword = Trim(buf)
    End If
    'debug.print UCase(firstword);
    Select Case UCase(firstword)
      Case "FROM:"
        message.MAILfrom = addressparse(Trim(Mid(buf, 6)))
      Case "FORWARDED" 'FORWARDED BY:'
        message.Forwardedby = addressparse(Trim(Mid(buf, 14)))
      Case "DATE:"
        message.DateofMessage = dateparse(Trim(Mid(buf, 6)))
      Case "TO:"
        ReDim Preserve message.mailto(UBound(message.mailto) + 1)
        message.mailto(UBound(message.mailto)) = addressparse(Trim(Mid(buf, 4)))
        'debug.print "to - name"; message.mailto(UBound(message.mailto)).name
        'debug.print "to - Post_office"; message.mailto(UBound(message.mailto)).Post_office
      Case "CC:"
        ReDim Preserve message.mailcc(UBound(message.mailcc) + 1)
        message.mailcc(UBound(message.mailcc)) = addressparse(Trim(Mid(buf, 4)))
      Case "BCC:"
        ReDim Preserve message.mailbcc(UBound(message.mailbcc) + 1)
        message.mailbcc(UBound(message.mailbcc)) = addressparse(Trim(Mid(buf, 5)))
      Case "*TO:"
        ReDim Preserve message.mailalsoto(UBound(message.mailalsoto) + 1)
        message.mailalsoto(UBound(message.mailalsoto)) = addressparse(Trim(Mid(buf, 5)))
      Case "*CC:"
        ReDim Preserve message.mailalsocc(UBound(message.mailalsocc) + 1)
        message.mailalsocc(UBound(message.mailalsocc)) = addressparse(Trim(Mid(buf, 5)))
'        Case "PRIORITY:"

      Case "SUBJECT:"
        message.subject = Trim(Mid(buf, 9))
      Case "RRQ:"
        message.RRQ = True
      Case "RRT:"
        message.RRQ = True
      Case "CONTENTS:"
 '       Line Input #thefileFH, buf ' this cound be the message!!
        isenvelope = False
    End Select
  Loop
  If isenvelope Then
    Close #thefileFH
    'debug.print "Found eof befoure contents"
    tempstring = getnewfilename(CCERRORDIR)
    FileCopy CCMAILTEMPFILE & "1", tempstring
    Exit Sub
  End If

  'debug.print "Found the body"
  textbodyflag = False
  ' now for the body
    ' look for ' title = Text Item....
readnextline:
 If EOF(thefileFH) Then
  ' a single line message!
  'debug.print "found the EOF"
  GoTo eofmpart
End If
    Line Input #thefileFH, buf
    'debug.print "Testing ::"; buf
interpret_start:
   'debug.print "Checking : "; buf

   ' text item
    If UCase(Left(buf, 10)) = "TEXT ITEM:" Then
      'debug.print "Found Text Item"
                ReDim Preserve TextItems(UBound(TextItems) + 1)
                With TextItems(UBound(TextItems))
                  .Title = "Title : " & Trim(Mid(buf, 11))
                  .Body = ""
                End With
readnexttextline:
                If EOF(thefileFH) Then
                   GoTo eofmpart
                End If
                Line Input #thefileFH, buf
                'debug.print UCase(Mid(buf, 6, 4));
                If Not (UCase(Left(buf, 9)) = "FILE ITEM" Or UCase(Left(buf, 9)) = "TEXT ITEM") Then
                    With TextItems(UBound(TextItems))
                      If Trim(buf) = "." Then
                      .Body = .Body & ".." & vbCrLf
                      Else
                      .Body = .Body & buf & vbCrLf
                      End If
                    End With
                    If Not EOF(thefileFH) Then
                      GoTo readnexttextline
                    End If
                Else
                  GoTo interpret_start
                End If
      End If

     ' file item-------------------------
      If UCase(Left(buf, 10)) = "FILE ITEM:" Then
            'debug.print "found fileitem : "; Trim(Mid(buf, 11))

            ReDim Preserve FileItems(UBound(FileItems) + 1)
            FileItems(UBound(FileItems)) = Trim(Mid(buf, 11))
            If InStr(FileItems(UBound(FileItems)), " ") Then
               FileItems(UBound(FileItems)) = Left(FileItems(UBound(FileItems)), InStr(FileItems(UBound(FileItems)), " ") - 1)
            End If
        '    If InStr(FileItems(UBound(FileItems)), ".") = 0 Then
            '  If Not Dir(CCMAILEXPORTFOLDER & FileItems(UBound(FileItems))) = "" Then
          '        Name CCMAILEXPORTFOLDER & FileItems(UBound(FileItems)) As CCMAILEXPORTFOLDER & FileItems(UBound(FileItems)) & ".doc"
         '        FileItems(UBound(FileItems)) = FileItems(UBound(FileItems)) & ".doc"
         '     End If  'try and fix a bit for mac->pc??
        '    End If

            'debug.print "Added item: "; FileItems(UBound(FileItems))

                ' what happens on mac files???
            GoTo readnextline
       End If

       'text on its own without item bit!
        If Trim(buf) = "" Then
          If textbodyflag Then
            TextItems(0).Body = TextItems(0).Body & buf & vbCrLf
          End If
        Else
          textbodyflag = True
          If Trim(buf) = "." Then
            TextItems(0).Body = TextItems(0).Body & ".." & vbCrLf
          Else
            TextItems(0).Body = TextItems(0).Body & buf & vbCrLf
          End If
        End If

       GoTo readnextline
eofmpart:
  Close #thefileFH
End Sub





Sub createsmtpfile()
  Dim outFH As Integer
  Dim realfiles As Long
  Dim test As Variant
  Dim i As Long, j As Long
  Dim thenumber As Long
  Dim rmailstring As String
  Dim addrstring As String
  Dim extension As String
  Dim contenttype As String
  Dim basesixtyfourFH As Integer
  Dim basesixtyfourstatus As Integer
  Dim buf As String
  Dim efforts As Integer
  Dim temptime As Date

  '1st lets see if there are any files to make  up.
  realfiles = 0
  If UBound(FileItems) > 0 Then
        For i = 1 To UBound(FileItems)
              If Not Dir(CCMAILEXPORTFOLDER & FileItems(i)) = "" Then
                    realfiles = realfiles + 1
              Else
                    'debug.print "Couldnt find "; CCMAILEXPORTFOLDER & FileItems(i)
              End If
        Next
  End If
  'debug.print "Found "; realfiles; " files"
  ' try doing a dummy to get it to fail!
  If realfiles > 0 Then
    ' create the mime message!

          For i = 1 To UBound(FileItems)
                 Call UUVBInit
                  If Not Dir(CCMAILEXPORTFOLDER & FileItems(i)) = "" Then
                         test = UUEncodeToFile(0, CCMAILEXPORTFOLDER & FileItems(i), _
                         B64ENCODED, FileItems(i), CCMAILWORKINGFOLDER & "PARTa" & i, 0)
                  Else
                    'debug.print "failed to find file " & CCMAILEXPORTFOLDER & FileItems(i)
                  End If
                  Call UUVBShutdown
          Next

          ' now I'm supposed to have the files in PART1 PART2....PARTx .001 !

  End If
  ' get a number!

  'SMTP HEADER  - ASSUME THAT THE NEXT PROCESS WILL INTERPRET THIS INFORMATION!!

     ' from is reversed?
  ReDim ADDRESSto(0)
  With message
    ADDRESSfrom = getinetaddr(.MAILfrom)
    rmailstring = ""
    For i = 1 To UBound(.mailto)
      ReDim Preserve ADDRESSto(UBound(ADDRESSto) + 1)
      ADDRESSto(UBound(ADDRESSto)) = getinetaddr(.mailto(i))
    Next
    For i = 1 To UBound(message.mailcc)
    ReDim Preserve ADDRESSto(UBound(ADDRESSto) + 1)
            ADDRESSto(UBound(ADDRESSto)) = getinetaddr(.mailcc(i))
    Next
    For i = 1 To UBound(message.mailbcc)
    ReDim Preserve ADDRESSto(UBound(ADDRESSto) + 1)
            ADDRESSto(UBound(ADDRESSto)) = getinetaddr(.mailbcc(i))
    Next
    MAXto = UBound(ADDRESSto)

   Form1.List1.AddItem "[" & Format(Now, "hh:nn") & " CCSMTP] : Really to : " & rmailstring, 0


  outFH = FreeFile
  Open CCMAILWORKINGFOLDER & "SMTPOUT" & ".txt" For Output As #outFH
  'RFC HEADER BIT!
    Print #outFH, rfclineout("Date: " & rfcdate(.DateofMessage))
    Print #outFH, rfclineout("From: " & getinetaddr(.MAILfrom))
    Form1.List1.AddItem "[" & Format(Now, "hh:nn") & " CCSMTP] : FROM : " & getinetaddr(.MAILfrom), 0
    Print #outFH, rfclineout("Sender: " & getinetaddr(.MAILfrom))
    Print #outFH, rfclineout("Reply-To: " & getinetaddr(.MAILfrom))
    Print #outFH, rfclineout("Subject: " & .subject)
    If UBound(.mailbcc) > 0 And UBound(.mailto) = 0 And UBound(.mailcc) = 0 Then
      Print #outFH, rfclineout("To: undisclosed recipients:")
    End If
    addrstring = ""
    For i = 1 To UBound(.mailto)
      addrstring = addrstring & getinetaddr(.mailto(i)) & ", "
    Next
    For i = 1 To UBound(message.mailalsoto)
      addrstring = addrstring & getinetaddr(.mailalsoto(i)) & ", "
    Next
    If Not addrstring = "" Then
      addrstring = Left(addrstring, Len(addrstring) - 2) ' take away the '
      Form1.List1.AddItem "[" & Format(Now, "hh:nn") & " CCSMTP] : TO: " & addrstring, 0
      Print #outFH, rfclineout("To: " & addrstring)
    End If

    addrstring = ""
    For i = 1 To UBound(message.mailcc)
      addrstring = addrstring & getinetaddr(.mailcc(i)) & ", "
    Next
    For i = 1 To UBound(.mailalsocc)
      addrstring = addrstring & getinetaddr(.mailalsocc(i)) & ", "
    Next
    If Not addrstring = "" Then
      addrstring = Left(addrstring, Len(addrstring) - 2)
            Form1.List1.AddItem "[" & Format(Now, "hh:nn") & " CCSMTP] : CC: " & addrstring, 0
      Print #outFH, rfclineout("cc: " & addrstring)
    End If
  End With
  Print #outFH, "message-ID: " & rfcmakeID()

  boundary = "VBccmailgateway" & Format(Now, "yymmddhhnnss")
     'and todays date time for diferenciating quoted msgs.
  Print #outFH, "MIME-Version: 1.0"
  Print #outFH, "Content-Type: multipart/mixed; boundary=" & boundary
  Print #outFH, ""
  Print #outFH, "This is a multi-part message in MIME format."
  Print #outFH, ""
'Thats the header done, now for the message!!
  'debug.print "textitems = " & UBound(TextItems)
   Print #outFH, "--" & boundary
      Print #outFH, "  Content-Type: text/plain;  charset = ""iso-8859-1"""
     Print #outFH, "Content -Transfer - encoding: quoted -printable"
      Print #outFH, ""



  For i = 0 To UBound(TextItems)
    If Not TextItems(i).Body = "" Then
      Print #outFH, ""
      If Not TextItems(i).Title = "" Then
        Print #outFH, TextItems(i).Title
        Print #outFH, ""
      End If
      Print #outFH, TextItems(i).Body
    End If
  Next
  'debug.print "looping 1 to "; UBound(FileItems); " looking for exported files!"
  For i = 1 To UBound(FileItems)
    'debug.print "going for file " & i
    If Dir(CCMAILWORKINGFOLDER & "PARTa" & i & ".001") = "" Then
      'debug.print "Couldnt find "; CCMAILWORKINGFOLDER & "PARTa" & i & ".001"
    Else
      ' create the mime header!
      Print #outFH, ""
      Print #outFH, "--" & boundary

      j = Len(FileItems(i))
      Do While Not Mid(FileItems(i), j, 1) = "."
        j = j - 1
        If j = 0 Then
          Exit Do
        End If
      Loop
      If j > 0 Then
        extension = Mid(FileItems(i), j - 1)
      Else
        extension = ""
      End If
      Select Case UCase(extension)
        Case "JPG"
          contenttype = "image/jpeg"

'MIME TYPES GO IN HERE!!
        Case Else
          contenttype = "application/octet-stream"
      End Select

      Print #outFH, "Content-transfer-encoding: base64"
      Print #outFH, "Content-disposition: attachment; filename=""" & FileItems(i) & """"
      Print #outFH, "Content-type: " & contenttype & "; name=""" & FileItems(i) & """"
      Print #outFH, ""
            Form1.List1.AddItem "[" & Format(Now, "hh:nn") & " CCSMTP] : FILES: " & FileItems(i), 0
      basesixtyfourFH = FreeFile
      Open CCMAILWORKINGFOLDER & "PARTa" & i & ".001" For Input As #basesixtyfourFH
      basesixtyfourstatus = 0
      Do While Not EOF(basesixtyfourFH)
        Line Input #basesixtyfourFH, buf
        Select Case basesixtyfourstatus
          Case 0
            If Not Trim(buf) = "" Then
              basesixtyfourstatus = 1
            End If
          Case 1
            If Trim(buf) = "" Then
              basesixtyfourstatus = 2
            End If
          Case 2
            If Not Trim(buf) = "" Then
              Exit Do
            End If
        End Select
      Loop
      Print #outFH, buf
      Do While Not EOF(basesixtyfourFH)
        Line Input #basesixtyfourFH, buf
        Print #outFH, buf
      Loop
      Close #basesixtyfourFH
    End If



  Next i ' next file!!!
  Print #outFH, ""
  Print #outFH, "--" & boundary & "--"
  Close #outFH

    For i = 1 To UBound(FileItems)
          If Not Dir(CCMAILWORKINGFOLDER & "PARTa" & i) = "" Then
                 Kill CCMAILWORKINGFOLDER & "PARTa" & i
          End If
  Next
  sendingmail = True
  smtpsend.domail
  Do While sendingmail
    DoEvents
  Loop
End Sub




Function ccexport_summary(ByRef messageids() As String) As Long
Dim thistime As Date
  Dim ccexportcmdline As String
  Dim buf As String
  ReDim messageids(0)
  ' create the string to do the export
  Dim idshell As Long
  Dim abc As Integer
  If Dir(Left(CCMAILWORKINGFOLDER, Len(CCMAILWORKINGFOLDER) - 1), vbDirectory) = "" Then
    MkDir Left(CCMAILWORKINGFOLDER, Len(CCMAILWORKINGFOLDER) - 1)
  End If

  ccexportcmdline = CCMAILEXPORTprognFOLDER & "EXPORT " & GatewayPO & " " & CCMAILpassword & " " _
    & CCMAILpodir & " @" & CCMAILTEMPFILE & " HEADINGS/ALL" & vbCrLf
  #If fullrun Then

  abc = FreeFile
  Open CCMAILWORKINGFOLDER & "export.bat" For Output As #abc
  Print #abc, ccexportcmdline
  'debug.print ccexportcmdline
  Print #abc, "dir " & CCMAILWORKINGFOLDER & "export.bat > " & CCMAILWORKINGFOLDER & "9999.999"
  Close #abc
  If Not Dir(CCMAILWORKINGFOLDER & "9999.999") = "" Then
    Kill CCMAILWORKINGFOLDER & "9999.999"
  End If
  idshell = Shell(CCMAILWORKINGFOLDER & "export.bat", 0)
  #Else
  'debug.print ccexportcmdline
  #End If
  thistime = Now + 0.002 ' 2 minutes
  Do While Dir(CCMAILWORKINGFOLDER & "9999.999") = ""  'wait for it to finish
    DoEvents
    If Now > thistime Then
        'debug.print "Nothing found"
        ccexport_summary = 0
        Exit Function
    End If
  Loop
  If Dir(CCMAILTEMPFILE) = "" Then
     'debug.print "Nothing found"
     ccexport_summary = 0
     Exit Function
  End If
  abc = FreeFile
  Open CCMAILTEMPFILE For Input As #abc
  Do While Not EOF(abc)
    Line Input #abc, buf
    'debug.print buf

    If UCase(Left(buf, 4)) = "MSG#" Then
      ReDim Preserve messageids(UBound(messageids) + 1)
      'debug.print "adding at "; UBound(messageids); " value "; Trim(Mid(buf, 6))
      messageids(UBound(messageids)) = Trim(Mid(buf, 6))
    End If
  Loop
  Close #abc
  ' clean up - eg delete export.bat & ccmailtempfile!
  Kill CCMAILTEMPFILE


   ccexport_summary = UBound(messageids)

End Function


Sub ccexport_file(messageid As String)
  ' create the string to do the export
  Dim idshell As Long
  Dim abc As Integer
  Dim ccexportcmdline As String
  ccexportcmdline = CCMAILEXPORTprognFOLDER & "EXPORT " & GatewayPO & " " & CCMAILpassword _
     & " " & CCMAILpodir & " @" & CCMAILTEMPFILE & "1" & _
       " FILES/DETACH READ/" & messageid & " END/1" & vbCrLf
  abc = FreeFile
  #If fullrun Then
  Open CCMAILWORKINGFOLDER & "export.bat" For Output As #abc
  Print #abc, ccexportcmdline
  Print #abc, "dir " & CCMAILWORKINGFOLDER & "export.bat > " & CCMAILWORKINGFOLDER & "9999.999"
  Close #abc
  #End If
   'debug.print ccexportcmdline
  #If fullrun Then
 If Not Dir(CCMAILWORKINGFOLDER & "9999.999") = "" Then
    Kill CCMAILWORKINGFOLDER & "9999.999"
  End If

  idshell = Shell(CCMAILWORKINGFOLDER & "export.bat", 0)
  #End If
  Do While Dir(CCMAILWORKINGFOLDER & "9999.999") = ""  'wait for it to finish
    DoEvents
  Loop



End Sub

Function dateparse(adatestring As String) As Date
  dateparse = Now ' until i can think of anything better!
End Function


Function addressparse(ccmailaddress As String) As ccADDRESS ' format xxxx at xxxx
  Dim buf As String
  buf = Trim(ccmailaddress)
  With addressparse
    If InStr(buf, " ") > 0 Then
      .name = Left(buf, InStr(buf, " ") - 1)
    Else
      .name = buf
    End If
    If InStr(LCase(buf), " at ") > 0 Then
      .Post_office = Trim(Mid(buf, InStr(LCase(buf), " at ") + 4))
      If InStr(.Post_office, " ") > 0 Then
        .Post_office = Left(.Post_office, InStr(.Post_office, " ") - 1)
      End If
    Else
      .Post_office = LocalPO
    End If
  End With
End Function


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


Function uucpgetinetaddr(theaddress As ccADDRESS) As String
' convert the PO to internet!
'  [e-mail] at internet -> [e-mail]
  'abc at cgcs -> [e-mail]
  'abc at envhkpo -> [e-mail]
  With theaddress
    Select Case LCase(.Post_office)
       Case LCase(GatewayPO)
         If InStr(.name, "@") > 0 Then
           uucpgetinetaddr = Mid(.name, InStr(.name, "@") + 1) & "!" & Left(.name, InStr(.name, "@") - 1)
        Else
          uucpgetinetaddr = inetDOMAIN & "!" & DEFAULTfromUSER
        End If
      Case LCase(LocalPO), ""
         uucpgetinetaddr = inetDOMAIN & "!" & .name
      Case Else
         uucpgetinetaddr = inetDOMAIN & "!" & .name & "." & .Post_office & ".ccmail"
      End Select
  End With
End Function
Function getinetaddr(theaddress As ccADDRESS) As String
  With theaddress
    Select Case LCase(.Post_office)
       Case LCase(GatewayPO)
         If InStr(.name, "@") > 0 Then
           getinetaddr = .name
        Else
           getinetaddr = DEFAULTfromADDRESS
        End If
      Case LCase(LocalPO), ""
          getinetaddr = .name & "@" & inetDOMAIN
      Case Else
          getinetaddr = .name & "." & .Post_office & ".ccmail@" & inetDOMAIN
      End Select
  End With
End Function

Function rfcdate(adate As Date) As String
  rfcdate = Format(adate, "ddd, d mmm yyyy hh:nn:ss ") & GMToffset
End Function


Function rfclineout(buf As String) As String
  Dim totallen As Long
  Dim i As Long, j As Long
  If Len(buf) < 79 Then
    rfclineout = buf
    Exit Function
  End If
  rfclineout = ""
  totallen = Len(buf)
  j = 1
  i = 60
  Do While Not i = j
    If Mid(buf, i, 1) = " " Then
      'cut here!
      rfclineout = rfclineout & Mid(buf, j, (i - j)) & vbCrLf & "  "
      j = i + 1
      i = j + 60
      If i > totallen Then
        rfclineout = rfclineout & Mid(buf, j)
        Exit Do
      End If
    Else
      i = i - 1
    End If
  Loop
End Function


Function rfcmakeID()
 rfcmakeID = "<" & Format(Now, "yymmddhhnnss") & Globalsequence & "@" & inetDOMAIN & ">"
 Globalsequence = Globalsequence + 1
End Function







Sub parse_smtp(smtpfilename As String)
  Dim returncode As Variant
  Dim rc As Integer, fpath As String
  Dim flags As Integer
  Dim ptr As Long, nextptr As Long, filestatus As String
  Dim uuret As Long, mvret As Long
  Dim smtpFH As Integer
  Dim buf As String
  Dim parsestring As String
  Dim extension As String
  Dim thefilename As String
  Dim thefilenumber As Long
  Dim filen As String
  Dim atest As Variant

Dim readfilestatus As Integer
Dim hasgotamimebit As Boolean
Dim statusline As Long
statusline = 0
  hasgotamimebit = False
  Clearmessage
  smtpFH = FreeFile
  'debug.print "reading smtp file :"; CCMAILWORKINGFOLDER & smtpfilename
   Form1.List2.AddItem "[" & Format(Now, "hh:nn") & " SMTPIN] : Reading file " & CCMAILWORKINGFOLDER & smtpfilename, 0
  Open CCMAILWORKINGFOLDER & smtpfilename For Input As #smtpFH
  ' read SMTP header
  Line Input #smtpFH, buf
  Do While Not UCase(Trim(buf)) = "DATA"
    'debug.print "Comparing :-: "; buf
    Select Case Left(UCase(buf), 4)
      Case "MAIL"
        If InStr(buf, "<") > 0 Then
          buf = Mid(buf, InStr(buf, "<") + 1)
          If InStr(buf, ">") Then
            buf = Left(buf, InStr(buf, ">") - 1)
          End If
          message.MAILfrom = smtpaddrparse(buf)
          'debug.print "set  mailfrom"; message.MAILfrom.name, " -at-"; message.MAILfrom.Post_office
           Form1.List2.AddItem "[" & Format(Now, "hh:nn") & " SMTPIN] : From " & message.MAILfrom.name & " AT " & message.MAILfrom.Post_office, 0
        End If

      Case "RCPT"
        If InStr(buf, "<") > 0 Then
          buf = Mid(buf, InStr(buf, "<") + 1)
          If InStr(buf, ">") Then
            buf = Left(buf, InStr(buf, ">") - 1)
          End If
          ReDim Preserve message.mailto(UBound(message.mailto) + 1)
          message.mailto(UBound(message.mailto)) = smtpaddrparse(buf)
          'debug.print "Added a recipient : "; message.mailto(UBound(message.mailto)).name; " -at- "; message.mailto(UBound(message.mailto)).Post_office
           Form1.List2.AddItem "[" & Format(Now, "hh:nn") & " SMTPIN] : TO :" & message.mailto(UBound(message.mailto)).name & " AT " & message.mailto(UBound(message.mailto)).Post_office, 0

        End If
    End Select
  Line Input #smtpFH, buf
  Loop
  ' cleared the smtp now read the envelope!!
  ' loop basis -> read a line, get the next line, if it starts with white space then
  ' it belongs to current line ->append!
  ' otherwise process, reset string
  boundary = ""
  parsestring = ""
  Do While Not buf = ""
  ' starts with DATA!
    If Left(buf, 1) = " " Or Left(buf, 1) = Chr(9) Then 'space or tab - continue!
      parsestring = parsestring & buf
      'debug.print "ADDED a line"
    Else
        parseprocess parsestring
        parsestring = buf
    End If
    If EOF(smtpFH) Then
      Exit Do 'eof error!
    End If
    Line Input #smtpFH, buf
    'debug.print "buf=" & buf
  Loop
  parseprocess parsestring

  If EOF(smtpFH) Then
    'error no message exists!!!
    Close #smtpFH
    Exit Sub
  End If

  readfilestatus = 0
   ' values 0 = im just reading
   'value 1 = im reading a file
   ' value 2 = im reading text header
  ' value 3 = im reading text body

  On Error GoTo finishedreadingfile

  Do While Not EOF(smtpFH)
    Select Case readfilestatus
        Case 0 ' im just reading
            If Left(LCase(buf), 13) = "content-trans" Then ' trans means int encoded
              readfilestatus = 1
              GoTo readnext
            End If
            If Left(LCase(buf), 19) = "content-disposition" Or Left(LCase(buf), 12) = "content-type" Then
              readfilestatus = 2 ' could be file or text
              GoTo readnext
            End If
              If buf = "--" & boundary & "--" Or buf = "--" & boundary Then
                   GoTo readnext
              End If

           If TextItems(0).Body = "" And buf = "" Then
                GoTo readnext
           Else
             TextItems(0).Body = TextItems(0).Body & buf & vbCrLf
           End If


        Case 1 ' im reading a file
              If buf = "--" & boundary & "--" Or buf = "--" & boundary Then
                   readfilestatus = 0
              End If
        Case 2 ' = im reading text header or file header
            If Left(LCase(buf), 13) = "content-trans" Then ' trans means int encoded
              readfilestatus = 1
              hasgotamimebit = True
              GoTo readnext
            End If
            If buf = "" Then ' got to the text bit!
              readfilestatus = 3
              GoTo readnext
            End If
        Case 3 ' = im reading text body

              If buf = "--" & boundary & "--" Or buf = "--" & boundary Then
                   readfilestatus = 0

                   GoTo readnext:
              End If
              TextItems(0).Body = TextItems(0).Body & buf & vbCrLf
      End Select
readnext:
      Form1.txCountdown.Caption = "Reading " & statusline
      statusline = statusline + 1
    Line Input #smtpFH, buf
    DoEvents
Loop
  GoTo rfinishedreadingfile
finishedreadingfile:
Resume rfinishedreadingfile
rfinishedreadingfile:
  On Error GoTo failedtoclose
  Close #smtpFH
  GoTo rfailedtoclose
failedtoclose:
Resume rfailedtoclose
rfailedtoclose:
  On Error GoTo 0
  Call UUVBInit
  returncode = UULoadFile(CCMAILWORKINGFOLDER & smtpfilename, CCMAILWORKINGFOLDER & smtpfilename, False)

  If UUVBListFirst(ptr) = False Then
    'debug.print "It recons nothing there!!"
     Call UUVBShutdown
     GoTo showbody     ' No files found
  End If

  Do While Not ptr = 0
    Debug.Print "uuvblist returns "; UUVBListWalk(ptr, fpath, filestatus, flags, nextptr)
    'debug.print "File:" & fpath & " -> " & filestatus
    ' converting fpath into filename! ' should be able to use filestatus later
    ' have to convert to 8.3 for godole ccmail dos
    If InStr(fpath, ":") > 0 Then
      fpath = Mid(fpath, InStr(fpath, ":") + 1)
    End If



    If InStr(Right(fpath, 5), ".") > 0 Then
      extension = Mid(Right(fpath, 5), InStr(Right(fpath, 5), ".") + 1, 3)
      If InStr(Left(fpath, 8), ".") > 0 Then
        thefilename = Left(fpath, InStr(Left(fpath, 8), ".") - 1)
      Else
        thefilename = Left(fpath, 8)
      End If
    Else
      thefilename = Left(fpath, 8)
      extension = "000"
    End If
    If thefilename = "" Then
      thefilename = "file"
    End If
    If Not Dir(CCMAILWORKINGFOLDER & thefilename & "." & extension) = "" Then
      thefilenumber = 0
      Do While Not Dir(CCMAILWORKINGFOLDER & thefilename & "." & Format(thefilenumber, "000")) = ""
        thefilenumber = thefilenumber + 1
      Loop
      If InStr(thefilename, " ") > 0 Then
        filen = CCMAILWORKINGFOLDER & Left(thefilename, InStr(thefilename, " ") - 1) & "." & Format(thefilenumber, "000")
      Else
        filen = CCMAILWORKINGFOLDER & thefilename & "." & Format(thefilenumber, "000")
      End If
    Else
      If InStr(thefilename, " ") > 0 Then
       filen = CCMAILWORKINGFOLDER & Left(thefilename, InStr(thefilename, " ") - 1) & "." & extension
      Else

       filen = CCMAILWORKINGFOLDER & thefilename & "." & extension
      End If
    End If
  'debug.print "going to use " & filen
    If Not UUVBDecode(ptr, flags, filen, uuret, mvret) Then
       'if it failed to decode then just send the body!
       Debug.Print "Failed somehow"
      Call UUVBShutdown
      GoTo trynext
    End If
    ReDim Preserve FileItems(UBound(FileItems) + 1)
    'debug.print "added " & filen
    FileItems(UBound(FileItems)) = filen '(eg. with dir info?)
trynext:
    ptr = nextptr
  Loop
  Call UUVBShutdown
  If ismime Then
    Exit Sub
  End If
' if the message was not a mime or it failed,
showbody:
  ' cop out area - if it all failed just attach the message as a file
'    If hasgotamimebit = True Then
      FileItems(0) = smtpfilename
'    End If



End Sub
Sub parseprocess(astring As String)

 'debug.print "Parsing Line "; astring
  'find location of ':'
  Dim colonlocation As Integer
  Dim itemis As String
  Dim datais As String
  Dim currenttestaddress  As String
  colonlocation = InStr(astring, ":")
  If colonlocation = 0 Then
    Exit Sub
  End If
  itemis = Trim(LCase(Left(astring, colonlocation - 1)))
  datais = Trim(Mid(astring, colonlocation + 1))
  'debug.print itemis; " -> "; datais
  Select Case LCase(itemis)
'    Case ">from" - got from from the SMTP header!!

'=     Case "bcc" lets ignore this, if it is bcc then it can be to!

    Case "bcc"
      Do While Not datais = ""
        If InStr(datais, ",") > 0 Then
          currenttestaddress = Trim(Left(datais, InStr(datais, ",") - 1))
          datais = Trim(Mid(datais, InStr(datais, ",") + 1))
        Else
          currenttestaddress = Trim(datais)
          datais = ""
        End If
        ReDim Preserve message.mailbcc(UBound(message.mailbcc) + 1)
        message.mailbcc(UBound(message.mailbcc)) = smtpaddrparse(currenttestaddress)
      Loop

    Case "cc"
      Do While Not datais = ""
        If InStr(datais, ",") > 0 Then
          currenttestaddress = Trim(Left(datais, InStr(datais, ",") - 1))
          datais = Trim(Mid(datais, InStr(datais, ",") + 1))
        Else
          currenttestaddress = Trim(datais)
          datais = ""
        End If
        ReDim Preserve message.mailalsocc(UBound(message.mailalsocc) + 1)
        message.mailalsocc(UBound(message.mailalsocc)) = smtpaddrparse(currenttestaddress)
      Loop
    Case "date"
      message.DateofMessage = rfcdataparse(datais)
'   Case "from"
 ' IGNORE THIS?? - use smtp bit!
   'Case "followup-to"

   'Case "in-reply-to"

   'Case "message-id"

    Case "mime-version"
      ismime = True ' if it aint then we append the text to the file!
'   Case "Path"
 '  Case "Reply-To"
 '  Case "References"
   Case "subject"
     message.subject = datais
'   Case "Sender"
   Case "to"
            'debug.print "got  astring in to ;"; astring
            Do While Not datais = ""
              If InStr(datais, ",") > 0 Then
                currenttestaddress = Trim(Left(datais, InStr(datais, ",") - 1))
                datais = Trim(Mid(datais, InStr(datais, ",") + 1))
              Else
                currenttestaddress = Trim(datais)
                datais = ""
              End If
              ReDim Preserve message.mailalsoto(UBound(message.mailalsoto) + 1)
              message.mailalsoto(UBound(message.mailalsoto)) = smtpaddrparse(currenttestaddress)
            Loop

   Case "content-type"
     'debug.print "found content-type"
              If InStr(LCase(datais), "boundary=") > 0 Then
      'debug.print "found boundary"
                    boundary = Mid(datais, InStr(LCase(datais), "boundary=") + 9)
                    If Left(boundary, 1) = """" Then
                          boundary = Mid(boundary, 2)
                    End If
                    If Right(boundary, 1) = """" Then
                          boundary = Left(boundary, Len(boundary) - 1)
                    End If
                    'debug.print "BOUNDARY IS '" & boundary & "'"
              End If

  End Select
End Sub



Function Create_ccimport_file() As String
Dim i As Long
Dim j As Long
Dim ccimportfile  As String
Dim ccimportFH As Integer
Dim readfilestatus As Integer
Dim thisfilename As String
' before we start!!
' check for duplicates in the to/cc/bcc & the also tos!

'-> how this works ..
' all to address are stored in the mailto
' to derive their true meaning need to use the
' also tos


  For i = 1 To UBound(message.mailto)

    'to copy
    For j = 0 To UBound(message.mailalsoto)
      If LCase(ccoutaddr(message.mailto(i))) = LCase(ccoutaddr(message.mailalsoto(j))) Then
        message.mailalsoto(j).Post_office = ""
        message.mailalsoto(j).name = ""
      End If
    Next



    'cc copy
    For j = 0 To UBound(message.mailalsocc)

      If LCase(ccoutaddr(message.mailto(i))) = LCase(ccoutaddr(message.mailalsocc(j))) Then
        ReDim Preserve message.mailcc(UBound(message.mailcc) + 1)
        message.mailcc(UBound(message.mailcc)) = message.mailto(i)
        message.mailto(i).Post_office = ""
        message.mailto(i).name = ""
        message.mailalsocc(j).Post_office = ""
        message.mailalsocc(j).name = ""
      End If
    Next
    For j = 0 To UBound(message.mailbcc)

      If LCase(ccoutaddr(message.mailto(i))) = LCase(ccoutaddr(message.mailbcc(j))) Then
        message.mailto(i).Post_office = ""
        message.mailto(i).name = ""
      End If
    Next


  Next
changedaddress:

  ccimportfile = CCMAILTEMPFILE
  If Not Dir(ccimportfile) = "" Then
     Kill ccimportfile
  End If


  ccimportFH = FreeFile
  Form1.List2.AddItem "[" & Format(Now, "hh:nn") & " CCOUT]  opening Output file", 0
  Open ccimportfile For Output As #ccimportFH

  Print #ccimportFH, "MESSAGE:"
  Print #ccimportFH, "FROM: " & ccoutaddr(message.MAILfrom)
  Print #ccimportFH, "DATE: " & ccoutdate(message.DateofMessage)
  For i = 1 To UBound(message.mailto)
    If Not message.mailto(i).name = "" Then
      Print #ccimportFH, "TO: " & ccoutaddr(message.mailto(i))
'      GoTo addedrecipient
    End If
  Next
  For i = 1 To UBound(message.mailcc)
    If Not message.mailcc(i).name = "" Then
      Print #ccimportFH, "CC: " & ccoutaddr(message.mailcc(i))
'      GoTo addedrecipient
    End If
  Next
  For i = 1 To UBound(message.mailbcc)
    If Not message.mailbcc(i).name = "" Then
      Print #ccimportFH, "BCC: " & ccoutaddr(message.mailbcc(i))
'      GoTo addedrecipient
    End If
  Next
addedrecipient:
  For i = 1 To UBound(message.mailalsoto)
    If Not message.mailalsoto(i).name = "" Then
      Print #ccimportFH, "*TO: " & ccoutaddr(message.mailalsoto(i))
    End If
  Next
  For i = 1 To UBound(message.mailalsocc)
    If Not message.mailalsocc(i).name = "" Then
      Print #ccimportFH, "*CC: " & ccoutaddr(message.mailalsocc(i))
    End If
  Next
  Print #ccimportFH, "SUBJECT: " & message.subject
  Print #ccimportFH, "CONTENTS:"
  Print #ccimportFH, ""
  'go through all the files and add the info!!
  'later we might import text files for bodys!



  For i = 1 To UBound(FileItems)
    If Not FileItems(i) = "" Then
             Form1.List2.AddItem "[" & Format(Now, "hh:nn") & " CCIMPORT]: Adding file " & FileItems(i), 0
      Print #ccimportFH, "File Item: " & FileItems(i)
    End If
  Next
  If Not TextItems(0).Body = "" Then
   Print #ccimportFH, "Text item:"
    Print #ccimportFH, TextItems(0).Body
  End If

  If Not FileItems(0) = "" Then
    Dim tempFHreadoriginal As Integer
    Dim buf As String
    tempFHreadoriginal = FreeFile
    Open CCMAILWORKINGFOLDER & FileItems(0) For Input As #tempFHreadoriginal
    Line Input #tempFHreadoriginal, buf
    Do While Not buf = ""
      Line Input #tempFHreadoriginal, buf
    Loop
    Print #ccimportFH, "Text item:"
    On Error GoTo skipreading
    Do While Not EOF(tempFHreadoriginal)
      Line Input #tempFHreadoriginal, buf
      Print #ccimportFH, buf
    Loop
    GoTo rskipreading
skipreading:
Resume rskipreading
rskipreading:
   On Error GoTo skipclosing
    Close #tempFHreadoriginal
    GoTo rskipclosing
skipclosing:
Resume rskipclosing
rskipclosing:
  On Error GoTo 0
    ' try using the mime parts to guess what the attachments might be
    ' start at beginning,
    ' skip header
    tempFHreadoriginal = FreeFile
    Open CCMAILWORKINGFOLDER & FileItems(0) For Input As tempFHreadoriginal
    Line Input #tempFHreadoriginal, buf
    Do While Not buf = ""
      Line Input #tempFHreadoriginal, buf
    Loop
     readfilestatus = 0
     On Error GoTo finishedreadingfile
     Do While Not EOF(tempFHreadoriginal)
      Line Input #tempFHreadoriginal, buf
      If buf = "." Then
        GoTo rfinishedreadingfile
      End If
      If buf = "--" & boundary & "--" Or buf = "--" & boundary Then
              readfilestatus = 1
      End If
      Select Case readfilestatus
         Case 1
           If InStr(LCase(buf), "filename") > 0 Then
              thisfilename = Trim(Mid(buf, InStr(LCase(buf), "filename") + 8))
              If InStr(thisfilename, "=") > 0 Then
                thisfilename = Trim(Mid(thisfilename, InStr(thisfilename, "=") + 1))
              End If
              ' enclosed in "
              If InStr(thisfilename, """") > 0 Then
                thisfilename = Trim(Mid(thisfilename, InStr(thisfilename, """") + 1))
                If InStr(thisfilename, """") > 0 Then
                  thisfilename = Trim(Left(thisfilename, InStr(thisfilename, """") - 1))
                End If
              End If
              If InStr(thisfilename, " ") > 0 Then
                thisfilename = Trim(Left(thisfilename, InStr(thisfilename, " ") - 1))
              End If
              readfilestatus = 2
           End If
          Case 2
            If buf = "" Then
                readfilestatus = 3
                Print #ccimportFH, "Text item: " & thisfilename
            End If
          Case 3
                Print #ccimportFH, buf
      End Select
    Loop
    GoTo rfinishedreadingfile
finishedreadingfile:
Resume rfinishedreadingfile
rfinishedreadingfile:
  On Error GoTo finishedclosingfile
    Close #tempFHreadoriginal
    GoTo rfinishedclosingfile
finishedclosingfile:
Resume rfinishedclosingfile
rfinishedclosingfile:
  End If
    Close #ccimportFH
  Create_ccimport_file = ccimportfile


End Function

Function smtpaddrparse(astring As String) As ccADDRESS
  ' format !
  Dim temppo As String
  Dim tempname As String
  Dim tempccmailpo As String
  Dim i As Long
  ' [e-mail] - > xxx at cgsa
  ' abc @ envision-design.com.hk -> xxx at envhkpo
  ' abc @ xyx.com -> [e-mail] at internet

  ' check for "<" & ">"


  If InStr(astring, "@") = 0 Then
       smtpaddrparse.Post_office = LocalPO
       smtpaddrparse.name = DEFAULTfromUSER
          'debug.print "address parse returns (NO @ SIGN) "; smtpaddrparse.name; " AT "; smtpaddrparse.Post_office; " from "; astring

       Exit Function
  End If
  temppo = Trim(Mid(astring, InStr(astring, "@") + 1))
  tempname = Trim(Left(astring, InStr(astring, "@") - 1))
  If InStr(tempname, "<") > 0 Then
    tempname = Mid(tempname, InStr(tempname, "<") + 1)
  End If
  If InStr(temppo, ">") > 0 Then
    temppo = Left(temppo, InStr(temppo, ">") - 1)
  End If



  If UCase(temppo) = UCase(inetDOMAIN) Then
        If UCase(Right(tempname, 7)) = ".CCMAIL" Then
             i = Len(tempname) - 7
             Do While Not Mid(tempname, i, 1) = "."
                    i = i - 1
                    If i = 0 Then
                       Exit Do
                   End If
              Loop
             If i = 0 Then
                   smtpaddrparse.Post_office = LocalPO
                   smtpaddrparse.name = DEFAULTfromUSER
                      'debug.print "address parse returns "; smtpaddrparse.name; "AT"; smtpaddrparse.Post_office; " from "; astring

                   Exit Function
            End If
            smtpaddrparse.Post_office = Mid(tempname, i + 1, Len(tempname) - 7 - i)
            smtpaddrparse.name = Left(tempname, i - 1)
        Else
              smtpaddrparse.Post_office = LocalPO
              smtpaddrparse.name = tempname
        End If
   Else
        smtpaddrparse.Post_office = GatewayPO
        smtpaddrparse.name = tempname & "@" & temppo
   End If
   'debug.print "address parse returns - " & smtpaddrparse.name & "-AT-" & smtpaddrparse.Post_office & "- from "; astring

End Function
Function ccimport_file(filetoimport As String) As Boolean
ccimport_file = True
  ' create the string to do the export
  Dim idshell As Long
  Dim abc As Integer
  Dim ccexportcmdline As String
  ccexportcmdline = CCMAILEXPORTprognFOLDER & "IMPORT " & LocalPO & " " & CCMAILpassword _
     & " " & CCMAILpodir & " @" & filetoimport & vbCrLf
  abc = FreeFile
    Form1.List2.AddItem "[" & Format(Now, "hh:nn") & " CCIMPORT]  attempting import"
  #If fullrun Then
  Open CCMAILWORKINGFOLDER & "export.bat" For Output As #abc
  Print #abc, ccexportcmdline
  Print #abc, "dir " & CCMAILWORKINGFOLDER & " export.bat > " & CCMAILWORKINGFOLDER & "9999.999"
  Close #abc
  'debug.print ccexportcmdline
  #Else
    'debug.print ccexportcmdline
  #End If
  #If fullrun Then
    If Not Dir(CCMAILWORKINGFOLDER & "9999.999") = "" Then
      Kill CCMAILWORKINGFOLDER & "9999.999"
    End If
    If Not Dir(CCMAILEXPORTFOLDER & "*.UND") = "" Then
       Kill CCMAILEXPORTFOLDER & Dir(CCMAILEXPORTFOLDER & "*.UND")
    End If

    idshell = Shell(CCMAILWORKINGFOLDER & "export.bat", 0)
    Do While Dir(CCMAILWORKINGFOLDER & "9999.999") = ""
      DoEvents
    Loop
        Form1.List2.AddItem "[" & Format(Now, "hh:nn") & " CCIMPORT]  finished importing", 0
     If Not Dir(CCMAILEXPORTFOLDER & "*.UND") = "" Then
       FileCopy CCMAILEXPORTFOLDER & Dir(CCMAILEXPORTFOLDER & "*.UND"), CCMAILEXPORTFOLDER & "probs\" & "error.und"
       ccimport_file = False
    End If
  #End If


End Function
Function ccoutaddr(anaddress As ccADDRESS)
  'debug.print "printing address :-" & anaddress.name & " AT " & anaddress.Post_office
  ccoutaddr = anaddress.name & " AT " & anaddress.Post_office
End Function
Function ccoutdate(adate As Date)
 ccoutdate = Format(adate, "m/d/yy h:nnAM/PM")
End Function
Function rfcdataparse(astring As String) As Date
  rfcdataparse = Now
End Function