Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Smtpserver code

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Smtpserver code

    This is the lastest version of the code for the smtpserver. I
    have added checking of base64 encode attachments and fixed a
    number of bugs in the filtering and bhl system. I have also add
    domain rejection as well.

    I have also picked a problems with the latest spam html emails.
    Email is a line based protocol and normally the lines are about
    80 characters long/ The programs that generate these html spam
    create lines up to 300 characters long. The system was truncating
    these long lines so the system checks for long lines and breaks
    then into a number of records.

    '==============================================================================
    ' SMTP Server Program Handler Version 1.10(SMTPD)
    ' Copyright (c) 2005 by Martin Draper
    '
    ' This library is free developer software; you can use it and/or
    ' modify it under the terms of the Phoenix Project Developer
    ' License. All commerical use and rights are strictly reserved.
    '
    ' This library is distributed in the hope that it will be useful,
    ' but WITHOUT ANY WARRANTY; without even the implied warranty of
    ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    '
    '
    '-------------------------------------------------------------------------------------
    ' Changes 30/9/2005 Blocking added for Server at the Helo Command and Sender
    ' blocking add at the Mail command
    ' Content filtering of the subject and body added
    ' Automatic Blackhole system implemented.
    '
    ' 01/9/2005 Add a function to determineand record the EmailType from the
    ' Content Header in the email if there is one. It defaults to
    ' text/plain.
    '
    ' EmailSize is now determined and recorded.
    '
    ' Maximum email size control added. If the max size is set and
    ' The email exceeds that size then email is junked.
    '
    ' Internal mail support. In businesses much of the email is internal
    ' from one staff member to another. If these emails did not have a
    ' realm attached "@yourserver.com" these emails could never leave the
    ' server and cannot be access from outside. NO SPAM ! Purely internal
    ' mail opens the way for sensitive material to be transfered more
    ' securely.
    '
    ' 02/10/2005 System Loging added
    '
    ' 02/02/2006 SqlFreeMemory to reduce the memory useage
    '
    ' 05/02/2006 Diagnostic level addedd
    '
    ' 12/02/2006 The Email Date is changed to a pure mysql date so the age of email can
    ' be checked.
    ' Null and "\" added to filtering.
    '
    ' 13/2/2006 The email data in now stried line by line in the emails table
    '
    ' 19/02/2006 A field for encoding format added
    '
    ' 30/3/2006 The SequenceNo added to log files
    '
    ' 02/06/2005 Changes to error handling. You just can't exit out of the sequence
    ' you have to give an error message back to the send and get them to
    ' quit or they jusy keep send data which clogs the system
    '
    ' 05/06/2006 System crashed due to rubbish in the log. The Sequence failed in the
    ' data transmissiona and the system logged the juck as errors. They
    ' contained "'" and "," which are now being removed from the log entries
    '
    ' 13/2/2006 The have been problems with failure when the emails get to large.
    ' Basically storing the mail in blob has not worked and data is being
    ' lost
    '
    ' 18/6/2006 Long strings of html are being truncated the data is checked for length
    ' then the data is split into blocks
    '
    ' 22/6/2006 Base64 Scanning added
    '-------------------------------------------------------------------------------------
    ' Notes 30/9/2005 If you are using Sqlite instead of the Mysql you have to take out
    ' the "Use EmailServer" query as Sqlite Only supports one database.
    '
    ' 02/9/2005 The server will consist of 4 parts
    ' The SMTPD (This program which will receive incoming mail)
    ' The SMTP-REMOTE which forwards mail to external servers
    ' The POP3-Proxy which gets mail from external servers
    ' The POP3D which forwards mail to the user.
    '
    ' The will also be an SMTP Client and Pop3 Client for Applications
    '
    '-------------------------------------------------------------------------------------
    '
    #COMPILE EXE
    #DIM ALL

    '==============================================================================
    ' Multi threading do's and don'ts
    '
    ' Thread-efficient programs are efficiently parallelized programs.
    ' The use of global data is thread-unsafe. It should be maintained per thread or
    ' encapsulated, so that its access can be serialized. A thread may read an error
    ' code corresponding to an error caused by another thread.
    ' So variables with a thread should be local.
    '
    ' No data should be kept over successive calls, because different threads may
    ' successively call the function.
    ' The function must be completed with the thread.
    '
    ' In multi-threaded programs, all functions called by multiple threads must be thread-safe.
    ' It is a good programming practice to always use and write reentrant and thread-safe functions.
    '
    '------------------------------------------------------------------------------
    ' Include Files
    '
    #RESOURCE "SmtpServ.pbr"
    %USEMACROS = 1
    #INCLUDE "Win32API.inc"
    #INCLUDE "WS2_32.inc"
    #INCLUDE "\aims5\lib\MySqlDB.inc"
    #INCLUDE "dns3.inc"


    '------------------------------------------------------------------------------
    ' Equates and global variables
    '
    %TCP_ACCEPT = %WM_USER + 4093 ' Any value larger than %WM_USER + 500
    %TCP_SMTP = %WM_USER + 4094 ' Any value larger than %WM_USER + 500
    %TCP_MAIL = %WM_USER + 4095 ' Any value larger than %WM_USER + 500

    '
    GLOBAL hList AS LONG
    GLOBAL nServer AS LONG
    GLOBAL hSmtp AS LONG 'DWORD
    GLOBAL MailserverName AS STRING
    GLOBAL Filter() AS STRING
    GLOBAL FilterRecords AS LONG
    GLOBAL SenderLevel AS INTEGER
    GLOBAL ServerLevel AS INTEGER
    GLOBAL MaxEmailSize AS LONG
    '
    GLOBAL DiagLevel AS INTEGER
    '-------------------------------------------------------------------------
    ' BASE64 Decoding
    ' Original VBDOS Version by G. Balla, 1996 (Public Domain)
    ' PB/DOS Conversion by Marc van den Dikkenberg, 1999
    ' Modified for PBCC by Martin Draper 2000
    '
    '--------------------------------------------------------------------------
    GLOBAL icChopMask AS INTEGER ' Constant 8-bit mask (Faster than using string constants)
    GLOBAL icBitShift AS INTEGER ' Constant shift mask (Faster than using string constants)
    GLOBAL icStartMask AS INTEGER ' Initial mask value (Faster than using string constants)

    GLOBAL iRollOver AS INTEGER ' Decoded Roll over value
    GLOBAL iHighMask AS INTEGER ' Mask high bits of each char
    GLOBAL iShift AS INTEGER ' Multiplier shift value
    GLOBAL iLowShift AS INTEGER ' Mask low bits of each char

    GLOBAL szAlphabet AS STRING ' Decode/Encode Lookup Table
    GLOBAL szTemp AS STRING ' Working string
    '
    '----------------------------------------------------------------------------------------------
    ' Name: INITDECODE64
    ' Type: Sub procedure
    ' Description: Initializes local shared variables for DECODE64$
    ' Required because many encoded files cannot be decoded in a single string
    '
    ' Used: Before decoding a BASE64 file. (DECODE64$)
    ' Arguements: None
    ' Returns: Nothing
    '
    ' Errors: None
    '
    ' Global Variables used:
    ' szAlphabet Encode/Decode Table lookup
    '
    ' icChopMask Constant value in variable to speed process
    ' icBitShift Constant value in variable to speed process
    ' icStartMask Constant value in variable to speed process
    '
    ' iShift Multiplier shift value
    ' iLowShift Mask Low bits of each char
    ' iRollOver Decoded Roll over value from prev char in string
    ' iHighMask Mask high bits of each char
    '----------------------------------------------------------------------------------------------
    SUB InitDecode64

    ' Initialize 2nd encoding pass lookup dictionary
    szAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

    ' Initialize Constants
    icChopMask = 255
    icBitShift = 4
    icStartMask = &H10

    ' Initialize Masks
    iShift = icBitShift
    iLowShift = 0
    iRollOver = 0
    iHighMask = -1
    '
    END SUB
    '
    '----------------------------------------------------------------------------------------------
    ' Name: DECODE64$
    ' Type: String function
    ' Description: decodes a string from BASE64 to binary format
    '
    ' Arguements: Source string to decode (szEncoded)
    ' Last string in file to decode flag (iEndOfText)
    ' Returns: Un-Encoded binary string.
    '
    ' Errors: Generates an Error via ERROR statement.
    ' Error code: 253 = No string to decode
    ' -----------------------------------------------
    ' NOTES: Must call INITDECODE64 before sending 1st string of an encoded file.
    '
    ' A DOEVENTS occurs near the end of the FOR/NEXT loop
    ' -----------------------------------------------
    ' Global variables: szAlphabet ' Decode/Encode lookup table
    ' szTemp ' Working string
    '
    ' iRollOver ' Decode/Encode rollover value
    ' iHighMask ' High bit mask
    ' iShift ' Multiplier value
    '
    '
    ' Local variables: iChar ' Ascii Char value from Encoded string
    ' iPtr ' Lookup table pointer
    ' iCounter ' FOR/NEXT counter
    '
    '----------------------------------------------------------------------------------------------
    FUNCTION DECODE64$ (szEncoded AS STRING, iEndOfText AS INTEGER)
    '
    ' Create variables
    DIM iPtr AS INTEGER
    DIM iChar AS INTEGER
    DIM iCounter AS INTEGER
    '
    ' Check if empty decoded string.
    ' If Empty, return NUL and Generate error 254
    '
    IF LEN(szEncoded) = 0 THEN
    DECODE64$ = ""
    ERROR 253
    EXIT FUNCTION
    END IF

    ' Initialize working string
    szTemp = ""

    ' Begin Decoding
    FOR iCounter = 1 TO LEN(szEncoded)

    ' Get next alphabet
    iChar = ASC(MID$(szEncoded, iCounter, 1))

    ' Get Decoded value
    iPtr = INSTR(szAlphabet, CHR$(iChar)) - 1

    ' Check if character is valid
    IF iPtr >= 0 THEN

    ' Char is valid, process it
    IF iShift = icBitShift THEN

    ' 1st char in block of 4, keep high part of character
    iRollOver = (iPtr * iShift) AND icChopMask

    ' Reset masks for next character
    iHighMask = &H30
    iLowShift = icStartMask
    iShift = icStartMask

    ELSE

    ' Start saving decoded character
    szTemp = szTemp + CHR$(iRollOver OR ((iPtr AND iHighMask) / iLowShift))

    ' Calculate next mask and shift values
    iRollOver = (iPtr * iShift) AND icChopMask
    iShift = iShift * icBitShift
    iHighMask = (iHighMask \ icBitShift) OR &H30
    iLowShift = iLowShift / icBitShift

    IF iShift > 256 THEN
    iShift = icBitShift
    iLowShift = 0
    END IF
    END IF

    END IF
    NEXT

    ' Concat last character if required
    IF (iShift > icBitShift AND iShift < 256) THEN

    ' Character remaining in iRollOver
    IF iEndOfText THEN

    ' Last string to decode in file
    szTemp = szTemp + CHR$(iRollOver)
    END IF
    END IF

    ' Exit wth decoded string
    DECODE64$ = szTemp
    '
    END FUNCTION
    '-----------------------------------------------------------------------------
    ' Retrieve the current time and date in E-mail header format
    '
    FUNCTION MailDate () AS STRING

    LOCAL szFormat AS ASCIIZ * 40
    LOCAL szTemp AS ASCIIZ * 40
    LOCAL sResult AS STRING
    LOCAL t AS SYSTEMTIME
    LOCAL sUCTOffset AS STRING
    LOCAL tzi AS TIME_ZONE_INFORMATION

    GetLocalTime t

    szFormat = "ddd',' dd MMM yyyy"
    GetDateFormat %LOCALE_USER_DEFAULT, 0, t, szFormat, szTemp, SIZEOF(szTemp)
    sResult = szTemp

    szFormat = "HH':'mm':'ss"
    GetTimeFormat %LOCALE_USER_DEFAULT, 0, t, szFormat, szTemp, SIZEOF(szTemp)

    SELECT CASE GetTimeZoneInformation(tzi)
    CASE %TIME_ZONE_ID_DAYLIGHT
    sUCTOffset = IIF$((tzi.bias + tzi.DaylightBias) <= 0, "+", "-") _
    + FORMAT$((tzi.bias + tzi.DaylightBias) \ 60, "00") _
    + FORMAT$((tzi.bias + tzi.DaylightBias) MOD 60, "00")
    CASE %TIME_ZONE_ID_STANDARD
    sUCTOffset = IIF$((tzi.bias + tzi.StandardBias) <= 0, "+", "-") _
    + FORMAT$((tzi.bias + tzi.StandardBias) \ 60, "00") _
    + FORMAT$((tzi.bias + tzi.StandardBias) MOD 60, "00")
    CASE ELSE
    sUCTOffset = "-0000"
    END SELECT

    FUNCTION = sResult + " " + szTemp + " " + sUCTOffset

    END FUNCTION


    '------------------------------------------------------------------------------
    ' Event logging
    '
    SUB LogEvent (BYVAL Buffer AS STRING)

    LOCAL idx AS LONG

    Buffer = DATE$ +" "+ TIME$ + " - " + Buffer
    idx = SendMessage(hList, %LB_ADDSTRING, 0, STRPTR(Buffer))
    SendMessage hList, %LB_SETCURSEL, idx, 0

    END SUB

    SUB SmtpLog(Event AS STRING,Action AS STRING, SequenceNo AS LONG,UserID AS STRING)
    '
    ' record and event in the smtp log
    '
    REPLACE "'" WITH "" IN Event
    REPLACE "'" WITH "" IN Action
    REPLACE "," WITH "" IN Event
    REPLACE "," WITH "" IN Action
    '
    SqlQuery "Insert into SmtpLog (LogID,LogDate,Event,Action,SequenceNo,Username) " + _
    " values ( '',Now(),'"+Event+"','"+Action+"','"+TRIM$(STR$(SequenceNo))+"','"+UserID+"')"
    '
    END SUB

    FUNCTION LoadFilter AS INTEGER
    '
    LOCAL Index AS LONG
    '
    ' Get the number of filters
    '
    SqlQuery "Select Count(FilterString) from Filter"
    GetRecord
    FilterRecords = VAL(Field(1))
    SqlFreeMemory
    '
    REDIM Filter(FilterRecords)
    '
    ' load the records in to the array
    '
    SqlQuery "Select FilterString from Filter"
    FOR Index = 1 TO RowCount
    GetRecord
    Filter(Index) = UCASE$(TRIM$(Field(1)))
    NEXT I
    '
    SqlFreeMemory
    '
    'SmtpLog "Filter Loaded " + str$(RowCount) + " Records" , Filter(1) + "->" + Filter(Rowcount-1),0,"System"

    END FUNCTION

    FUNCTION InitListen(hDlg AS DWORD) AS INTEGER
    '
    LOCAL sBuffer AS STRING
    '
    ' open the socket for smtp
    '
    nServer = FREEFILE
    TCP OPEN SERVER "smtp" AS nServer
    '
    IF ERR THEN
    sBuffer = "Unable to listen to smtp"
    FUNCTION = 0
    ELSE
    '
    ' Notify will specify which notifications your code will process, use the TCP NOTIFY statement:
    ' It tells Winsock that it should send the %TCP_ACCEPT message to the window specified by nServer.
    '
    TCP NOTIFY nServer, ACCEPT TO hDlg AS %TCP_ACCEPT
    sBuffer = "Connected to smtp"
    FUNCTION = 1
    END IF
    LogEvent sBuffer
    '
    END FUNCTION

    FUNCTION AcceptConnection(hDlg AS DWORD) AS INTEGER
    '
    ' Create a socket to the client
    '
    hSmtp = FREEFILE
    TCP ACCEPT nServer AS hSmtp
    '
    ' send the server connect message
    '
    TCP SEND hSmtp, "220 "+MailserverName+" ESMTP System v3.1.2" + $CRLF
    '
    ' The Helo is next
    '
    TCP NOTIFY hSmtp, RECV TO hDlg AS %TCP_SMTP
    LogEvent "connection accepted"
    '
    FUNCTION = 1
    '
    END FUNCTION

    FUNCTION SmtpTHread(hSmtp AS DWORD) AS INTEGER
    '
    ' hello from the client
    ' RFC 1123 requires that the parameter be a valid principal host domain name for the client host.
    ' However, some clients don't have names. I recommend that they use bracketed IP addresses:
    '
    ' The server's response text begins with the server's name. The server must be careful not to
    ' use another host's name here: if a sendmail client on that host connects and sees its own name,
    ' it will refuse to ``talk to itself.
    '
    ' Some servers do not accept MAIL requests before HELO. Clients use HELO as the first request
    ' in every session. (Exception: see EHLO.) This is a waste of time. I recommend that server
    ' implementors let clients skip HELO, to support a future transition to a world without HELO.
    '
    ' Beware that many servers reject all HELO requests after the first, so clients cannot rely
    ' on HELO as a way to clear the envelope. For example, sendmail returns a 503 code.
    '
    ' A few servers reject messages from clients whose HELO parameters do not match the results
    ' of PTR lookups on their IP addresses. This behavior is a disaster in practice; surveys in
    ' 1998 found that more than 10% of all clients by volume use invalid HELO parameters.
    ' Compuserve reportedly uses unqualified names:
    '
    ' RFC 1123 Requirements for Internet Hosts - Application and Support
    ' prohibits HELO-based rejections
    '
    ' HELO testmx.unixwiz.net
    ' 554 <testmx.unixwiz.net> Helo command rejected: Access denied
    '
    LOCAL Buffer AS STRING
    LOCAL MailServer AS STRING
    LOCAL MailHost AS STRING
    LOCAL MailFrom AS STRING
    LOCAL MailTo AS STRING
    '
    LOCAL EmailSubject AS STRING
    LOCAL EmailDate AS STRING
    LOCAL EmailData AS STRING
    LOCAL Destination AS STRING
    LOCAL DestinationDomain AS STRING
    LOCAL DestinationID AS LONG
    LOCAL Source AS STRING
    LOCAL SourceDomain AS STRING
    LOCAL EmailSize AS LONG
    LOCAL EmailType AS STRING
    LOCAL MessageID AS STRING
    LOCAL Retries AS INTEGER
    LOCAL SequenceNo AS LONG
    LOCAL FileHandle AS LONG
    LOCAL TotalSize AS LONG
    LOCAL Encoding AS STRING
    LOCAL FilterIndex AS LONG
    LOCAL Reason AS STRING
    '
    LOCAL Index AS LONG
    LOCAL Reject AS INTEGER
    LOCAL BHLID AS LONG
    LOCAL FieldStart AS INTEGER
    LOCAL FieldEnd AS INTEGER
    LOCAL QuotaSize AS LONG
    LOCAL QuotaCount AS LONG
    LOCAL Username AS STRING
    '
    LOCAL Recipients() AS STRING
    LOCAL NoRecipients AS INTEGER
    LOCAL LoopTrap AS INTEGER
    '
    LOCAL DataAccepted AS INTEGER
    '
    REDIM Field(32),Recipients(100)
    NoRecipients = 0
    Retries = 0
    Reject = 0
    Reason = ""
    '
    IF SqlConnect = 0 THEN
    SmtpLog "Unable to Connect to Database Server ", "Connection Terminated",SequenceNo,Username
    LogEvent "Unable to Connect to Database Server "
    EXIT FUNCTION
    END IF
    '
    SqlQuery "Use pbmail"
    SmtpLog "Connected to Database Server ", "Processing Started",SequenceNo ,Username
    '
    ' load the content filter table
    '
    LoadFilter
    '
    '
    ' get the next sequence number for the email
    '
    5 FileHandle = FREEFILE
    OPEN "sequence" FOR INPUT AS FileHandle
    INPUT #FileHandle , SequenceNo
    CLOSE FileHandle
    '
    SequenceNo = SequenceNo + 1
    '
    FileHandle = FREEFILE
    OPEN "sequence" FOR OUTPUT AS FileHandle
    PRINT #FileHandle , SequenceNo
    CLOSE FileHandle
    ' '
    ' helo
    '
    10 TCP LINE hSmtp, buffer
    '
    IF ERR > 0 THEN
    SmtpLog "Session Failed from "+MailFrom, "Connection Dropped",SequenceNo,Username
    LogEvent "Session Failed from "+MailFrom
    GOTO 999
    END IF
    '
    '
    '
    ' Looping trap
    '
    IF Buffer = "" THEN
    loopTrap = LoopTrap + 1
    IF LoopTrap > 20 THEN
    SmtpLog "Connection Looped Out " + MailServer, "Connection Terminated",SequenceNo,Username
    GOTO 999
    END IF
    SLEEP 1000
    GOTO 10
    ELSE
    LoopTrap = 0
    END IF
    '
    SmtpLog "Data Received " + MailServer, Buffer,SequenceNo,Username
    '
    ' start helo
    '
    IF LEFT$(UCASE$(Buffer),4) = "HELO" THEN
    MailServer = TRIM$(MID$(Buffer,5,LEN(buffer)-4))
    TCP SEND hSmtp, "250 HELO " + MailserverName + "."+buffer+ $CRLF
    LogEvent "HELO connection accepted from " + MailServer
    IF DiagLevel = 1 OR DiagLevel = 2 THEN LogEvent "connection accepted from " + MailServer
    END IF

    '
    ' spammers will send email from the address of the server.
    ' this will block this email
    '
    'IF Mailserver = "202.94.66.101" _
    ' OR LCASE$(RIGHT$(MailServer,3)) = ".pl" _
    ' OR LCASE$(RIGHT$(MailServer,3)) = ".hu" _
    ' OR INSTR(LCASE$(MailServer),"bounce") > 0 THEN
    ' SmtpLog "HELO Rejected from " + MailServer, "Spam Deteced",SequenceNo,Username
    ' GOTO 999
    'END IF
    '
    'Mailhost = MX_Query(Mailserver, "ns1.hypermax.net.au")
    'SmtpLog "Dns check " + MailServer,">"+ MailHost + "< found",SequenceNo,Username
    '
    ' Black hole blocking
    '
    'Field(1) = ""
    'SqlQuery " Select BHLID from BHL where Domain = '"+MailServer+"' and DomainStatus = 'Active'"
    'GetRecord
    'SqlFreeMemory
    'IF VAL(Field(1)) > 0 THEN
    ' TCP SEND hSmtp, "554 " + MailserverName + "Helo command rejected: Access denied" + $CRLF
    ' SmtpLog "HELO Rejected from " + MailServer, "Connection Terminated",SequenceNo,Username
    ' LogEvent "HELO Rejected from " + MailServer
    ' GOTO 999
    'ELSE
    'END IF
    'GOTO 10

    '
    ' start elho
    '
    IF LEFT$(UCASE$(Buffer),4) = "EHLO" THEN
    MailServer = TRIM$(MID$(Buffer,5,LEN(buffer)-4))
    TCP SEND hSmtp, "250 HELO " + MailserverName + "."+buffer+ $CRLF
    LogEvent "EHLO connection accepted from " + MailServer
    IF DiagLevel = 1 OR DiagLevel = 2 THEN LogEvent "connection accepted from " + MailServer
    END IF
    '
    ' spammers will send email from the address of the server.
    ' this will block this email
    '
    'IF Mailserver = "202.94.66.101" _
    ' OR LCASE$(RIGHT$(MailServer,3)) = ".pl" _
    ' OR LCASE$(RIGHT$(MailServer,3)) = ".hu" _
    ' OR instr(LCASE$(MailServer),"bounce") > 0 THEN
    ' SmtpLog "HELO Rejected from " + MailServer, "Spam Deteced",SequenceNo,Username
    ' GOTO 999
    'END IF
    '
    'Mailhost = MX_Query(Mailserver, "ns1.hypermax.net.au")
    'SmtpLog "Dns check " + MailServer,">"+ MailHost + "< found",SequenceNo,Username
    '
    ' Black hole blocking
    '
    'SqlQuery " Select BHLID from BHL where Domain = '"+MailServer+"' and DomainStatus = 'Active'"
    'GetRecord
    'SqlFreeMemory
    'IF VAL(Field(1)) > 0 THEN
    ' TCP SEND hSmtp, "554 " + MailserverName + "Helo command rejected: Access denied" + $CRLF
    ' SmtpLog "EHLO Rejected from " + MailServer, "Connection Terminated",SequenceNo,Username
    ' LogEvent "EHELO Rejected from " + MailServer
    ' GOTO 999
    'ELSE

    '


    '
    ' TCP NOTIFY hSmtp, RECV SEND CLOSE TO hDlg AS %TCP_MAIL
    '
    ' MAIL FROM in the smtp this give you the email address of the client sending the email
    ' This command tells the SMTP-receiver that a new mail transaction is starting and to
    ' reset all its state tables and buffers, including any recipients or mail data. It
    ' gives the reverse-path which can be used to report errors. If accepted, the
    ' receiver-SMTP returns a 250 OK reply.
    '
    ' The <reverse-path> can contain more than just a mailbox. The <reverse-path> is a
    ' reverse source routing list of hosts and source mailbox. The first host in the
    ' <reverse-path> should be the host sending this command.
    '
    20 IF LEFT$(Buffer,4) = "MAIL" THEN
    MailFrom = MID$(Buffer,INSTR(Buffer,"<")+1,LEN(buffer)-INSTR(Buffer,"<")-1)
    Source = ""
    '
    ' get domain of the sender
    '
    FieldStart = INSTR(MailFrom,"@")
    IF FieldStart > 0 THEN
    SourceDomain = RIGHT$(MailFrom,LEN(MailFrom)-FieldStart)
    ELSE
    SourceDomain = ""
    END IF
    '
    ' domain rejection
    '
    Field(1) = ""
    SqlQuery " Select DomainID from Domains where instr('"+MailServer+"',Domain) > 0 " + _
    " or instr('"+MailFrom+"',Domain) > 0 "
    GetRecord
    SqlFreeMemory
    IF VAL(Field(1)) > 0 THEN
    TCP SEND hSmtp, "550 " + MailFrom + "Mail command rejected: Access denied" + $CRLF
    SmtpLog "MAIL " +MailFrom + " Rejected by Domain", "Connection Terminated",SequenceNo,Username
    LogEvent "MAIL " +MailFrom + " Rejected by Domain"
    GOTO 10
    END IF
    '
    ' Check the Black hole list
    '
    Field(1) = ""
    SqlQuery " Select BHLID from BHL where Domain = '"+MailFrom+"' and DomainStatus = 'Active'"
    GetRecord
    SqlFreeMemory
    IF VAL(Field(1)) > 0 THEN
    TCP SEND hSmtp, "550 " + MailFrom + "Mail command rejected: Access denied" + $CRLF
    SmtpLog "MailFrom: " +MailFrom + " Rejected by BHL -" + STR$(BHLID), "Connection Terminated",SequenceNo,Username
    LogEvent "MailFrom: " +MailFrom + " Rejected by BHL -" + STR$(BHLID)
    GOTO 10
    END IF
    '
    ' determine the Source
    '
    Field(1) = ""
    SqlQuery " Select LocalID from MailBoxes where LocalAddress = '"+MailFrom+"'"
    GetRecord
    SqlFreeMemory
    IF VAL(Field(1)) > 0 THEN
    Source = "Local"
    ELSE
    Source = "Forward"
    END IF
    '
    TCP SEND hSmtp, "250 " + MailFrom + " OK" + $CRLF
    SmtpLog "Process Mail From " +MailFrom,"MAIL Command Accepted",SequenceNo ,Username
    LogEvent "Process Mail From " +MailFrom
    GOTO 10
    END IF
    '
    ' This command gives a forward-path identifying one recipient.
    ' If accepted, the receiver-SMTP returns a 250 OK reply, and
    ' stores the forward-path. If the recipient is unknown the
    ' receiver-SMTP returns a 550 Failure reply. This second step of
    ' the procedure can be repeated any number of times.
    '
    ' The <forward-path> can contain more than just a mailbox. The
    ' <forward-path> is a source routing list of hosts and the
    ' destination mailbox. The first host in the <forward-path>
    ' should be the host receiving this command.
    ' RCPT To:<[email protected]>
    ' 554 <linux.unixwiz.net> Helo command rejected: Get lost - you're lying about who you are
    '
    ' The list is comprised of the email addresses of the recipients seperated by commas or semicolons.
    ' The email addresses found in BCC are not copied into the header of the email message.
    ' If the mail server has conformed strictly to the SMTP specifications it may limit the
    ' total number recipients to 100. Strict conformance to this number is not mandatory
    ' so your mail server may permit more than 100 recipients.
    '
    30 IF LEFT$(Buffer,4) = "RCPT" THEN
    Mailto = MID$(Buffer,INSTR(Buffer,"<")+1,LEN(buffer)-INSTR(Buffer,"<")-1)
    '
    ' Get the domain of recipient
    '
    FieldStart = INSTR(MailTo,"@")
    IF FieldStart > 0 THEN
    DestinationDomain = RIGHT$(MailTo,LEN(MailTo)-FieldStart)
    ELSE
    DestinationDomain = ""
    END IF
    '
    ' dns check
    '
    IF SourceDomain <> "" THEN
    Mailhost = MX_Query(SourceDomain, "203.87.88.1")
    SmtpLog "Mailhost", Mailhost ,SequenceNo,Username
    END IF
    '
    ' check routing for internal mail
    '
    IF DestinationDomain = "" THEN
    TCP SEND hSmtp, "550 Invalid Destination " + $CRLF
    SmtpLog "RCPT " +MailTo+ " Invalid Destination ", "Connection Terminated",SequenceNo,Username
    LogEvent "RCPT " +MailTo+ " Invalid Destination "
    GOTO 10
    END IF
    '
    ' determine the destination
    '
    Field(1) = ""
    SqlQuery " Select LocalID,EmailQuotaSize,EmailQuotaCount,Username from MailBoxes where LocalAddress = '"+MailTo+"'"
    GetRecord
    SqlFreeMemory
    IF VAL(Field(1)) > 0 THEN
    Destination = "Local"
    QuotaSize = VAL(Field(2))
    QuotaCount = VAL(Field(3))
    Username = Field(4)
    '
    ' check the quotas for the mailbox
    '
    IF QuotaSize > 0 OR QuotaCount > 0 THEN
    SqlQuery " Select Count(QueueID), Sum(EmailSize) from Queue where EmailTo = '"+MailTo+"'"
    GetRecord
    SqlFreeMemory
    IF (QuotaCount > 0 AND VAL(Field(1)) > QuotaCount) OR _
    (QuotaSize > 0 AND VAL(Field(2)) > QuotaSize) THEN
    TCP SEND hSmtp, "550 MailBox Full " + $CRLF
    SmtpLog "MailTo: " +MailTo+ " MailBox Full ", "Connection Terminated",SequenceNo,Username
    LogEvent "MailTo: " +MailTo+ " MailBox Full "
    GOTO 10
    END IF
    END IF
    ELSE
    Destination = "Forward"
    '
    ' Is the destination a local domain
    '
    Field(1) = ""
    IF DestinationDomain <> "" THEN
    SqlQuery " Select DomainID from Domains where Domain = '"+DestinationDomain+"'"
    GetRecord
    SqlFreeMemory
    IF VAL(Field(1)) > 0 THEN DestinationID = VAL(Field(1))
    END IF
    '
    END IF
    '
    ' relay check
    '
    IF Destination = "Forward" AND Source = "Forward" THEN
    IF DestinationID = 0 THEN
    TCP SEND hSmtp, "550 Relaying not permitted " + $CRLF
    SmtpLog "MailTo: " +MailTo+ " Relay Attempt Blocked ", "Connection Terminated",SequenceNo,Username
    LogEvent "MailTo: " +MailTo+ " Relay Attempt Blocked "
    GOTO 10
    ELSE
    TCP SEND hSmtp, "550 MailBox Unknown " + $CRLF
    SmtpLog "MailTo: " +MailTo+ " Mail Box Unknown ","Connection terminated",SequenceNo,Username
    LogEvent "MailTo: " +MailTo+ " Mail Box Unknown "
    GOTO 10
    END IF
    ELSE
    TCP SEND hSmtp, "250 " + MailTo + " OK" + $CRLF
    NoRecipients = NoRecipients + 1
    Recipients(NoRecipients) = MailTo
    SmtpLog "MailTo: " +MailTo, "RCPT Command Accepted",SequenceNo,Username
    LogEvent "MailTo: " +MailTo
    END IF
    GOTO 10
    END IF
    '
    ' If accepted, the receiver-SMTP returns a 354 Intermediate reply
    ' and considers all succeeding lines to be the message text.
    ' When the end of text is received and stored the SMTP-receiver
    ' sends a 250 OK reply.
    '
    IF LEFT$(Buffer,4) = "DATA" THEN
    '
    DataAccepted = 0
    '
    ' put a header on the email
    '
    SqlQuery "Insert into emails values ('','" + TRIM$(STR$(SequenceNo)) + "','"+ "Received: from " +MailServer+ "; " + MailDate + $CRLF+"')
    '
    '
    ' Set the Type of the email
    '
    EmailType = "text/plain"
    '
    TCP SEND hSmtp, "354 send the mail data, end with ." + $CRLF
    ' LogEvent "Start Data"
    '
    ' loop until the end of the data is received
    '
    50 TCP LINE hSmtp, buffer
    '
    ' error trap
    '
    IF ERR > 0 THEN
    SqlQuery "Insert into emails values ('','" + TRIM$(STR$(SequenceNo)) + "',' Connection Failed "+ $CRLF+"')
    SmtpLog "Forced End Data from "+MailFrom, "ERR " + STR$(ERR) + " Occured",SequenceNo,Username
    LogEvent "Forced End Data from "+MailFrom
    GOTO 60
    END IF
    '
    ' end of the data received
    '
    IF buffer = "." THEN GOTO 60
    '
    ' Looping trap
    '
    IF Buffer = "" THEN
    LoopTrap = LoopTrap + 1
    ELSE
    LoopTrap = 0
    END IF
    '
    IF LoopTrap > 30 THEN
    SqlQuery "Insert into emails values ('','" + TRIM$(STR$(SequenceNo)) + "','Data Failed"+ $CRLF+"')
    SmtpLog "Forced End Data from "+MailFrom, "DATA Looped Out",SequenceNo,Username
    LogEvent "Forced End Data from "+MailFrom
    GOTO 60
    END IF
    '
    '
    ' http encoding to avert problems with html
    '
    511 IF INSTR(buffer, CHR$(0)) > 0 THEN
    REPLACE CHR$(0) WITH "�" IN Buffer
    GOTO 511
    END IF

    51 IF INSTR(buffer, CHR$(34)) > 0 THEN
    REPLACE CHR$(34) WITH "&#34;" IN Buffer
    GOTO 51
    END IF

    53 IF INSTR(buffer, "'") > 0 THEN
    REPLACE "'" WITH "&#39;" IN Buffer
    GOTO 53
    END IF

    55 IF INSTR(buffer,",") > 0 THEN
    REPLACE "," WITH "&#44;" IN Buffer
    GOTO 55
    END IF
    '
    56 IF INSTR(buffer,"\") > 0 THEN
    REPLACE "\" WITH "&#92;" IN Buffer
    GOTO 56
    END IF
    '
    ' determine the content type
    '
    IF INSTR(UCASE$(Buffer),"CONTENT-TYPE:") > 0 THEN
    FieldEnd = INSTR(Buffer,";")
    IF FieldEnd = 0 THEN
    FieldEnd = LEN(Buffer)
    EmailType = MID$(Buffer,14,FieldEnd-13)
    ELSE
    EmailType = MID$(Buffer,14,FieldEnd-14)
    END IF
    END IF
    '
    ' subject line
    '
    IF INSTR(UCASE$(Buffer),"SUBJECT:") > 0 THEN
    EmailSubject = MID$(Buffer,INSTR(Buffer,":")+2,LEN(Buffer)-INSTR(Buffer,":")-1)
    END IF
    '
    ' Encoding Format
    '
    IF INSTR(UCASE$(Buffer),"ENCODING:") > 0 THEN
    Encoding = RIGHT$(Buffer,LEN(Buffer)-INSTR(Buffer,":")-1)
    END IF
    '
    ' Email date
    '
    IF INSTR(UCASE$(Buffer),"DATE:") > 0 THEN
    EmailDate = RIGHT$(Buffer,LEN(Buffer)-INSTR(Buffer,":")-1)
    END IF
    '
    ' Message-Id:
    '
    IF INSTR(UCASE$(Buffer),"MESSAGE-ID:") > 0 THEN
    MessageID = MID$(Buffer,INSTR(Buffer,":")+2,LEN(Buffer)-INSTR(Buffer,":")-1)
    END IF
    '
    ' Content filter the subject. If a reject word is found then exit
    ' no filtering on local email
    '
    IF Source = "Local" THEN GOTO 59
    '
    FOR FilterIndex = 1 TO FilterRecords
    IF UCASE$(TRIM$(Encoding)) <> "BASE64" AND _
    INSTR(UCASE$(Buffer),Filter(FilterIndex)) > 0 THEN
    Reason = Filter(FilterIndex)
    SmtpLog "Filter Detected ", Filter(FilterIndex),SequenceNo,"System"
    Reject = Reject + 1
    GOTO 59
    END IF
    IF UCASE$(TRIM$(Encoding)) = "BASE64" AND _
    INSTR(UCASE$(Decode64$(Buffer,-1)),Filter(FilterIndex)) > 0 THEN
    Reason = Filter(FilterIndex)
    SmtpLog "Base64 Filter Detected ", Filter(FilterIndex),SequenceNo,"System"
    Reject = Reject + 1
    GOTO 59
    END IF
    NEXT FilterIndex
    '
    ' save the email line by line instead of by block
    ' an number of emails have poorly formated html which appears as huge strings which
    ' are getting truncated so these strings are being chopped into smaller sections so
    ' data is not lost.
    '
    59 IF LEN(Buffer) < 250 THEN
    SqlQuery "Insert into emails values ('','" + TRIM$(STR$(SequenceNo)) + "','"+ Buffer + $CRLF+"')
    ELSE
    SqlQuery "Insert into emails values ('','" + TRIM$(STR$(SequenceNo)) + "','"+ LEFT$(Buffer,250)+"')
    Buffer = RIGHT$(Buffer, LEN(Buffer) - 250)
    GOTO 59
    END IF
    '
    TotalSize = TotalSize + LEN(Buffer)
    EmailSize = EmailSize + LEN(Buffer)
    '
    '59 EmailData = EmailData + buffer + $CRLF
    GOTO 50
    '
    ' attach the receive header
    '
    '60 EmailData = "Received: from " +MailServer+ "; " + MailDate + $CRLF + EmailData
    '
    ' Get the size of the email
    '
    ' EmailSize = LEN(EmailData)
    '
    ' send end of data
    '
    60 SqlQuery "Insert into emails values ('','" + TRIM$(STR$(SequenceNo)) + "','"+ $CRLF+"')
    SqlQuery "Insert into emails values ('','" + TRIM$(STR$(SequenceNo)) + "','"+ Buffer + $CRLF+"')
    TCP SEND hSmtp, "250 OK" + $CRLF
    SmtpLog "End Data from "+MailFrom, "DATA Command Accepted",SequenceNo,Username
    LogEvent "End Data from "+MailFrom
    '
    '
    '
    '
    ' Once the email data is received then save it then next
    ' duplicate message filter
    '
    100 SqlQuery " Select count(QueueID) from Queue where MessageID = '"+MessageID+"'"
    GetRecord
    SqlFreeMemory
    '
    IF VAL(Field(1)) > 0 AND MessageID <> "" THEN
    SmtpLog "Message exist in the Queue " +MessageID, "Message Rejected",SequenceNo,Username
    LogEvent "Message exist in the Queue " +MessageID
    GOTO 999
    END IF
    '
    SqlQuery " Select count(QueueID) from Rejects where MessageID = '"+MessageID+"'"
    GetRecord
    SqlFreeMemory
    '
    IF VAL(Field(1)) > 0 AND MessageID <> "" THEN
    SmtpLog "Message exist in the Rejects " +MessageID, "Message Rejected",SequenceNo,Username
    LogEvent "Message exist in the Rejects " +MessageID
    GOTO 999
    END IF
    '
    '
    '
    '
    ' Handling for Multiple Recipients
    ' The mail is basically the same for all the people in the Recipient list
    ' So entries into the queue process via a loop selecting the new Recipients
    ' each time. Recipients()
    '

    '
    ' If the email is to be rejected don't record the email just black whole the email
    '
    FOR Index = 1 TO NoRecipients
    MailTo = Recipients(Index)
    '
    IF Reject = 0 THEN
    IF (MaxEmailSize > 0 AND EmailSize < MaxEmailSize) OR Source = "Local" THEN
    SqlQuery "Insert into Queue values ( '','"+MailServer+"','"+MailFrom+"','"+MailTo+"','"+_
    EmailSubject +"',Now(),'','Received','"+Destination+"','" + _
    STR$(EmailSize) + "','" + EmailType + "','"+MessageID+"','"+ _
    STR$(Retries)+"','"+TRIM$(STR$(SequenceNo))+"','"+Encoding+"')"
    SmtpLog " Mail from "+MailServer+"."+MailFrom, "Accepted for "+MailTo,SequenceNo,Username
    LogEvent " Mail from "+MailServer+"."+MailFrom + "Accepted for "+MailTo
    ELSE
    SqlQuery "Insert into Rejects values ( '','"+MailServer+"','"+MailFrom+"','"+MailTo+"','"+_
    EmailSubject +"',Now(),'SequenceNo','MaxEmailSize','"+Destination+"','" + _
    STR$(EmailSize) + "','" + EmailType + "','"+MessageID+"','"+ _
    STR$(Retries)+"','"+TRIM$(STR$(SequenceNo))+"','"+Encoding+"')"
    SmtpLog " Mail from "+MailFrom+" exceeds MaxMailSize", "Email junked",SequenceNo,Username
    LogEvent " Mail from "+MailFrom+" exceeds MaxMailSize Rejected"
    END IF
    EmailData = ""
    SqlFreeMemory
    ELSE
    SqlQuery "Insert into Rejects values ( '','"+MailServer+"','"+MailFrom+"','"+MailTo+"','"+_
    EmailSubject +"',Now(),'"+Reason+"','Rejected','"+Destination+"','" + _
    STR$(EmailSize) + "','" + EmailType + "','"+MessageID+"','"+ _
    STR$(Retries)+"','"+TRIM$(STR$(SequenceNo))+"','"+Encoding+"')"

    SmtpLog " Mail from "+MailFrom+" Failed Filtering", "Rejected",SequenceNo,Username
    LogEvent " Mail from "+MailFrom+" Failed Filtering and Rejected"
    END IF
    '
    NEXT Index
    '
    IF Reject = 0 THEN GOTO 10
    '
    ' Black hole reject System
    ' Check senderlevel for blackhole if exceeded
    ' if it is not in the list add to the list to be watched
    ' if the sender is in the blackhole list then increamnet the rejects
    ' if the rejects are greater than the bhl senderlevel then blackhole the sender
    '
    ' if server is not in the list add the server to be watched
    ' if it is in th list increment the rejects
    ' if the rejects are greater than the server level then blackhole the server
    '
    ' Basically spammers come certain senders on certain server. If the system gets
    ' some many emails that are rejected by the system then that sender will be blocked
    ' but they will change their address. So if they move to another address it will start
    ' again and will be blocked again if they move more than some many times and get
    ' blocked then the server is blocked
    '
    '
    ' is the send in the list
    IF Reject = 0 THEN
    Sqlquery " Select BHLID from BHL where Domain = '"+MailFrom+"'"
    GetRecord
    SqlFreeMemory
    BHLID = VAL(TRIM$(Field(1)))
    IF BHLID > 0 THEN
    ' sender in the list increment the rejects
    Sqlquery " Update BHL set Rejects = Rejects + 1 where BHLID = "+STR$(BHLID)
    ' check the sender level
    Sqlquery " Select Rejects from BHL where BHLID = "+STR$(BHLID)
    GetRecord
    SqlFreeMemory
    ' is the sender level exceeded black hole the sender
    IF VAL(TRIM$(Field(1))) > SenderLevel THEN
    Sqlquery " Update BHL set DomainStatus = 'Active' where BHLID = "+STR$(BHLID)
    '
    '
    ' is the server in the blachole list
    Field(1) = ""
    Sqlquery " Select BHLID from BHL where Domain = '"+MailServer+"'
    GetRecord
    SqlFreeMemory
    BHLID = VAL(TRIM$(Field(1)))
    IF BHLID > 0 THEN
    ' server is on the list increment the server rejects
    Sqlquery " Update BHL set Rejects = Rejects + 1 where BHLID = "+STR$(BHLID)
    ' check the server level
    Sqlquery " Select Rejects from BHL where BHLID = "+STR$(BHLID)
    GetRecord
    SqlFreeMemory
    ' is the sender level exceeded black hole the server
    IF VAL(TRIM$(Field(1))) > ServerLevel THEN
    Sqlquery " Update BHL set DomainStatus = 'Active' where BHLID = "+STR$(BHLID)
    END IF
    '
    '
    ELSE
    ' add the server to the list
    Sqlquery " Insert into BHL values( '','" +MailServer +"',1,'Watching')
    END IF
    END IF
    '
    ' the sender is no in the list so addit
    '
    ELSE
    Sqlquery " Insert into BHL values( '','" +MailFrom +"',1,'Watching')
    END IF
    '
    END IF
    END IF
    '
    ' This is the quit command to complete the email
    ' This command specifies that the receiver must send an OK
    ' reply, and then close the transmission channel.
    '
    ' The receiver should not close the transmission channel until
    ' it receives and replies to a QUIT command (even if there was
    ' an error). The sender should not close the transmission
    ' channel until it send a QUIT command and receives the reply
    ' (even if there was an error response to a previous command).
    '
    ' If the connection is closed prematurely the receiver should
    ' act as if a RSET command had been received (canceling any
    ' pending transaction, but not undoing any previously
    ' completed transaction), the sender should act as if the
    ' command or transaction in progress had received a temporary
    ' error (4xx).

    90 IF LEFT$(UCASE$(Buffer),4) = "QUIT" THEN
    'TCP SEND hSmtp, "221 "+$CRLF
    GOTO 999
    END IF
    '
    ' This command specifies that the current mail transaction is
    ' to be aborted. Any stored sender, recipients, and mail data
    ' must be discarded, and all buffers and state tables cleared.
    ' The receiver must send an OK reply.
    '
    ' The rset command can be sent between messages so a new connection
    ' does not have to be made again. So the current email is complete
    ' then the process begins again.
    '

    IF LEFT$(UCASE$(Buffer),4) = "RSET" THEN
    TCP SEND hSmtp, "250 OK" + $CRLF
    SmtpLog "RSET from "+MailFrom, "RSET Command Accepted",SequenceNo,Username
    LogEvent "RSET"
    GOTO 10
    END IF
    '
    ' unsupported commands
    '
    IF LEFT$(UCASE$(Buffer),4) = "VRFY" THEN
    TCP SEND hSmtp, "501 OK" + $CRLF
    SmtpLog "VRFY from " + MailServer,"Connection terminated",SequenceNo,Username
    LogEvent "VRFY from " + MailServer +" Connection terminated"
    GOTO 999
    END IF
    '
    IF LEFT$(UCASE$(Buffer),4) = "EXPN" THEN
    TCP SEND hSmtp, "501 OK" + $CRLF
    SmtpLog "EXPN from " + MailServer,"Connection terminated",SequenceNo,Username
    LogEvent "EXPN from " + MailServer +" Connection terminated"
    GOTO 999
    END IF
    '
    IF LEFT$(UCASE$(Buffer),4) = "SOML" THEN
    TCP SEND hSmtp, "501 OK" + $CRLF
    SmtpLog "SOML from " + MailServer,"Connection terminated",SequenceNo,Username
    LogEvent "SOML from " + MailServer +" Connection terminated"
    GOTO 999
    END IF
    '
    IF LEFT$(UCASE$(Buffer),4) = "SEND" THEN
    TCP SEND hSmtp, "501 OK" + $CRLF
    SmtpLog "SEND from " + MailServer,"Connection terminated",SequenceNo,Username
    LogEvent "SEND from " + MailServer +" Connection terminated"
    GOTO 999
    END IF
    '
    IF LEFT$(UCASE$(Buffer),4) = "TURN" THEN
    TCP SEND hSmtp, "501 OK" + $CRLF
    SmtpLog "TURN from " + MailServer,"Connection terminated",SequenceNo,Username
    LogEvent "TURN from " + MailServer +" Connection terminated"
    GOTO 999
    END IF
    '
    IF LEFT$(UCASE$(Buffer),4) = "HELP" THEN
    TCP SEND hSmtp, "501 OK" + $CRLF
    SmtpLog "HELP from " + MailServer,"Connection terminated",SequenceNo,Username
    LogEvent "HELP from " + MailServer +" Connection terminated"
    GOTO 999
    END IF
    '
    GOTO 10
    '
    999 SmtpLog "Session Closed " + MailServer," Connection terminated",SequenceNo,Username
    LogEvent "Session Closed " + MailServer +" Connection terminated"
    SqlClose
    '
    END FUNCTION
    '------------------------------------------------------------------------------
    ' Callback function for the main dialog window
    '
    FUNCTION DlgProc (BYVAL hDlg AS DWORD, _
    BYVAL wMsg AS LONG, _
    BYVAL wParam AS LONG, _
    BYVAL lParam AS LONG) EXPORT AS LONG
    '
    STATIC nServer AS LONG
    '
    SELECT CASE wMsg
    '
    ' To create a TCP server, your program must first open a socket using the TCP OPEN SERVER statement.
    ' Then, when a client contacts your server, this socket will receive the notification.
    ' To specify which notifications your code will process, use the TCP NOTIFY statement:
    '
    CASE %WM_INITDIALOG
    hList = GetDlgItem(hDlg, 101)
    '
    ' open the socket for smtp
    '
    nServer = FREEFILE
    TCP OPEN SERVER "smtp" AS nServer TIMEOUT 50000
    IF ERR THEN
    logevent "Unable to listen to smtp"
    FUNCTION = 0
    ELSE
    '
    ' Notify will specify which notifications your code will process, use the TCP NOTIFY statement:
    ' It tells Winsock that it should send the %TCP_ACCEPT message to the window specified by nServer.
    '
    TCP NOTIFY nServer, ACCEPT TO hDlg AS %TCP_ACCEPT
    logevent "Connected to smtp"
    FUNCTION = 1
    END IF
    '
    ' The lParam& parameter to your callback will tell you what type of notification was sent:
    '
    CASE %TCP_ACCEPT
    SELECT CASE LOWRD(lParam)
    '
    CASE %FD_ACCEPT
    hSmtp = FREEFILE
    TCP ACCEPT nServer AS hSmtp ' Create a socket to the client
    TCP SEND hSmtp, "220 "+MailserverName+" ESMTP System v3.1.2" + $CRLF ' send the server connect message
    SmtpThread hSmtp
    CLOSE hSmtp
    END SELECT
    '
    FUNCTION = 1
    '
    CASE %WM_COMMAND
    SELECT CASE LOWRD(wParam)

    CASE 102
    EndDialog hDlg, 0
    FUNCTION = 1
    END SELECT
    '
    CASE %WM_DESTROY
    TCP CLOSE nServer
    LogEvent "Disconnected from Pop3"
    '
    CASE %WM_SYSCOMMAND
    IF (wParam AND &H0FFF0) = %SC_CLOSE THEN
    SendMessage hDlg, %WM_COMMAND, 102, 0
    FUNCTION = 1
    END IF

    END SELECT

    END FUNCTION

    '
    '------------------------------------------------------------------------------
    ' Main Application entry point...
    '
    FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
    BYVAL hPrevInstance AS LONG, _
    BYVAL lpCmdLine AS ASCIIZ PTR, _
    BYVAL iCmdShow AS LONG) AS LONG

    MailserverName = "mail.abconcepts.com.au"
    '
    ' get the server config
    '
    CHDIR "c:\pbmail"
    GetMysqlConfig
    '
    DiagLevel = 2
    '
    ' initate this program as a windows service
    '
    InitDecode64
    '
    ' set the automatic blackhole levels
    '
    SenderLevel = 5
    ServerLevel = 5
    MaxEmailSize = 5000000
    '
    DialogBox hInstance, BYVAL 100&, %HWND_DESKTOP, CODEPTR(DlgProc)

    END FUNCTION




    ------------------

  • #2
    This is all well and good, but where are the .INC and resource files that we can use to compile this code? It would help if you could zip up all the necessary files with this to make this compilable for those of us who are looking for code like this.

    Comment


    • #3
      {Removed} necro post
      <b>George W. Bleck</b>
      <img src='http://www.blecktech.com/myemail.gif'>

      Comment


      • #4
        Look at the OP's post date guys.... 26th June 2006

        Comment


        • #5
          And the OP's last visit:
          Martin Draper
          Member
          Last Activity: 21 Oct 2009, 02:23 AM
          Rod
          "To every unsung hero in the universe
          To those who roam the skies and those who roam the earth
          To all good men of reason may they never thirst " - from "Heaven Help the Devil" by G. Lightfoot

          Comment

          Working...
          X