Code aus frmMain.frm
' VB-Inside-SMTP-Server
' #####################
'
' Hinweis: Einige Funktionen funktionieren noch nicht vollständig,
' sie werden aber in der nächsten Version implementiert sein!
'
'
' Autor: Tim Braun
' Web:   www.vbinside.de
' Mail:  tim@hybridworx.de

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias _
    "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As _
    NOTIFYICONDATA) As Boolean
Const NIM_ADD = &H0
Const NIM_MODIFY = &H1
Const NIM_DELETE = &H2
Const NIF_MESSAGE = &H1
Const NIF_ICON = &H2
Const NIF_TIP = &H4
Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const WM_LBUTTONDBLCLK = &H203
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONUP = &H205
Const WM_RBUTTONDBLCLK = &H206
Private Type NOTIFYICONDATA
  cbSize As Long
  hWnd As Long
  uId As Long
  uFlags As Long
  ucallbackMessage As Long
  hIcon As Long
  szTip As String * 64
End Type
Dim TIcon As NOTIFYICONDATA
Private Sub Form_Load()
    With lvwSMTP
      .ColumnHeaders(1).Width = .Width / 4
      .ColumnHeaders(2).Width = .Width / 4 * 3 - 80
    End With
    
    mnuPopup.Visible = False
    picTray.Picture = Me.Icon
    
    Me.Hide
    App.TaskVisible = False
    
    TIcon.cbSize = Len(TIcon)
    TIcon.hWnd = picTray.hWnd
    TIcon.uId = 1&
    TIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    TIcon.ucallbackMessage = WM_MOUSEMOVE
    TIcon.hIcon = Me.Icon
    TIcon.szTip = "vbInside.de - Mail-Server" & Chr$(13) & _
        "Offline" & Chr$(0)
    
    Shell_NotifyIcon NIM_ADD, TIcon
    
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Me.Hide
    If UnloadMode = vbAppWindows Or UnloadMode = vbFormCode Then
      Shell_NotifyIcon NIM_DELETE, TIcon
    Else
      Cancel = 1
    End If
    
End Sub
Private Sub mnuConnectGlobal_Click()
'Initialisierungs-Funktionen aufrufen
    
    If InitSMTP Then
      mnuConnectGlobal.Enabled = False
      mnuDisconnectGlobal.Enabled = True
      mnuConnectPOP.Enabled = False
      mnuMailWindow.Enabled = True
      mnuDisconnectPOP.Enabled = True
      UpdateIcon "Online"
    End If
End Sub
Private Sub mnuConnectPOP_Click()
    mnuConnectGlobal_Click
End Sub
Private Sub mnuDisconnectGlobal_Click()
    mnuConnectGlobal.Enabled = True
    mnuConnectPOP.Enabled = True
    mnuDisconnectGlobal.Enabled = False
    mnuMailWindow.Enabled = False
    mnuDisconnectPOP.Enabled = False
    UpdateIcon "Offline"
End Sub
Private Sub mnuDisconnectPOP_Click()
    mnuDisconnectGlobal_Click
End Sub
Private Sub mnuEnd_Click()
    mnuDisconnectGlobal_Click
    Shell_NotifyIcon NIM_DELETE, TIcon
    Unload Me
End Sub
Private Sub mnuEndPOP_Click()
    mnuEnd_Click
End Sub
Private Sub mnuInfo2_Click()
    frmInfo.Show vbModal, Me
End Sub
Private Sub mnuInfosPop_Click()
    frmInfo.Show vbModal
End Sub
Private Sub mnuMailWindow_Click()
    frmEditor.Show
End Sub
Private Sub mnuProperties_Click()
    Call Shell("notepad.exe " & App.Path & "\config\smtp.cfg", _
        vbNormalFocus)
End Sub
Private Sub mnuStateWindow_Click()
    Me.Show
End Sub
Private Sub picTray_MouseMove(Button As Integer, Shift As Integer, _
    x As Single, Y As Single)
  Dim Msg&
    Msg = x / Screen.TwipsPerPixelX
    
    Select Case Msg
Case WM_MOUSEMOVE:
      Case WM_LBUTTONDBLCLK: Me.Show
Case WM_LBUTTONDOWN:
Case WM_LBUTTONUP:
      Case WM_RBUTTONDBLCLK: Me.Show
Case WM_RBUTTONDOWN:
      Case WM_RBUTTONUP: Me.PopupMenu mnuPopup, , , , mnuStateWindow
    End Select
    
End Sub
Private Sub SMTP_Close(Index As Integer)
    DelLWIP Index
End Sub
Private Sub SMTP_ConnectionRequest(Index As Integer, ByVal _
    requestID As Long)
  Dim x As Integer
    x = SMTP.UBound + 1
    
    Load SMTP(x)
    SMTP(x).Accept requestID
    
    If x >= SMTP_MaxConnections Then
      SMTP(x).SendData "421 Service überlastet, zu viele " & _
          "Verbindungen." & " Bitte später nochmal probieren!" & vbCrLf
      SMTP(x).Close
      Unload SMTP(x)
      Exit Sub
    End If
    
    AddSMTPLog "---------------" & vbCrLf & "Neue Verbindung" & _
        vbCrLf & "IP: " & SMTP(x).RemoteHostIP
    
    CreateNewMessage CInt(x)
    SMTP(x).SendData "220 " & HELO_Msg & vbCrLf
    AddLWIP SMTP(x).RemoteHostIP, "Verbunden", x
End Sub
Private Sub SMTP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    On Error Resume Next
  Static StillWaiting As Boolean
  Static dataTemp As String
  Dim actTemp As String
    
    'Anmerkung: Es müssen die Mail-Daten, bei <CRLF>.<CRLF> _
        woanders hingepackt
    'werden, sonst werden sie bei quit gelöscht!
    
    SMTP(Index).GetData actTemp
    Debug.Print actTemp
    If Not Len(actTemp) > 1 And Not GetWData(Index) Then
      Goto HIERWICHTIG
    End If
    
    If InStr(1, dataTemp, vbCrLf & "." & vbCrLf) <> 0 Or InStr(1, _
        actTemp, vbCrLf & "." & vbCrLf) <> 0 Or InStr(1, dataTemp _
        & actTemp, vbCrLf & "." & vbCrLf) <> 0 Then
      AddMailData Index, actTemp
      SMTP(Index).SendData "250 Daten ok! Mail wird versendet!" & vbCrLf
      DeleteMessage Index
      CreateNewMessage Index
      SetHELO Index, True
      SMTP_LastCommand = "HELO"
      SetWData Index, False
      dataTemp = ""
      Exit Sub
    ElseIf GetWData(Index) Then
      AddMailData Index, actTemp
      dataTemp = dataTemp & actTemp
    ElseIf actTemp = vbCrLf Or actTemp = vbLf And Not _
        SMTP_LastCommand = "DATA" Then
      dataTemp = dataTemp & actTemp
      InterpretSMTPData dataTemp, Index
      dataTemp = ""
    ElseIf Mid(actTemp, Len(actTemp) - 1) = vbCrLf Then
      dataTemp = dataTemp & actTemp
      InterpretSMTPData dataTemp, Index
      dataTemp = ""
    ElseIf Not Mid(actTemp, Len(actTemp) - 1) = vbCrLf Then
HIERWICHTIG:
      dataTemp = dataTemp & actTemp
    End If
    
    
End Sub
Private Sub SMTP_Error(Index As Integer, ByVal Number As Integer, _
    Description As String, ByVal Scode As Long, ByVal Source As _
    String, ByVal HelpFile As String, ByVal HelpContext As Long, _
    CancelDisplay As Boolean)
    AddSMTPLog "Fehler!" & vbCrLf & Description
    SMTP(Index).Close
    Unload SMTP(Index)
    DeleteMessage Index
    DelLWIP Index
End Sub
Function InterpretSMTPData(Data As String, Index As Integer)
'Interpretiert die Daten vom Mail-Programm
  Dim Recvs() As String
  Dim i As Long
  Dim valids As Boolean
    If Not GetHELO(Index) Then
      If Mid(Data, 1, 4) <> "HELO" Then
        SMTP(Index).SendData "503 Bitte erst HELO senden!" & vbCrLf
        Exit Function
      End If
    End If
    
    Select Case UCase(Mid(Data, 1, 4))
      Case "HELO"
        'User sendet HELO!
        SetHELO Index, True
        SMTP(Index).SendData "250 " & SMTP(Index).LocalHostName & _
            " Hello!" & vbCrLf
        SetLWState Index, "HELO"
      Case "MAIL"
        'Sender auslesen, gucken, ob eine "echte" Adresse angegeben
        'wurde und dann in die Sammlung eintragen
  Dim Sender As String
        Sender = Mid(Data, InStr(1, Data, ":") + 1)
        If Not IsvalidSender(Sender) Or Not InStr(1, UCase(Data), _
            "FROM") > 0 Then
          SMTP(Index).SendData "503 Kein echter Sender, oder " & _
              "falsche Argumente!" & vbCrLf
          Exit Function
        End If
        AddSender Index, Replace(Sender, vbCrLf, "")
        SMTP(Index).SendData "250 Sender ok!" & vbCrLf
        SMTP_LastCommand = "MAIL"
        SetLWState Index, "MAIL"
      Case "RCPT"
        'Gucken, ob der User einen validen Empfänger angegeben
        'hat und ihn dann eintragen
        SetLWState Index, "RCPT"
        If Not SMTP_LastCommand = "MAIL" Or SMTP_LastCommand = _
            "RCPT" Then
          SMTP(Index).SendData "503 Falsche Folgen, bitte erst " & _
              "MAIL senden!" & vbCrLf
          Exit Function
        End If
        
        If Not InStr(1, UCase(Data), "TO:") > 0 Then
          SMTP(Index).SendData "503 falsche Argumente!" & vbCrLf
          Exit Function
        End If
        Data = Replace(Data, vbCrLf, "")
        Recvs = Split(Mid(Data, InStr(1, Data, ":") + 1), ",")
        For x = LBound(Recvs) To UBound(Recvs)
          If IsvalidReceiver(Recvs(i)) = True Then
            AddReceiver Index, Trim(Recvs(x))
            valids = True
            SMTP(Index).SendData "250 " & Trim(Recvs(x)) & " ist " & _
                "ok!" & vbCrLf
          Else
            SMTP(Index).SendData "500 " & Trim(Recvs(x)) & ": " & _
                "Keine gültige Adresse!" & vbCrLf
          End If
        Next
      Case "QUIT"
        'Der User will die Verbindung beenden, wir verabschieden uns
        'und löschen seine Nachrichten...
        SetLWState Index, "QUIT"
        AddSMTPLog "----------------" & vbCrLf & _
            SMTP(Index).RemoteHostIP & " Verbindung beendet"
        SMTP(Index).SendData "221 Verbindung getrennt" & vbCrLf
        SMTP(Index).Close
        Unload SMTP(Index)
        DeleteMessage Index
        DelLWIP Index
      Case "DATA"
        WriteTemplateMessage Index
        SMTP_LastCommand = "DATA"
        SetLWState Index, "DATA"
        SMTP(Index).SendData "354 Mail-Eingabe. Beenden mit " & _
            "<CRLF>.<CRLF>" & vbCrLf
        SetWData Index, True
      Case "RSET"
        SMTP_LastCommand = ""
        DeleteMessage Index
        SetLWState Index, "RSET"
        SMTP(Index).SendData "250 Reset - ok!" & vbCrLf
      Case "NOOP"
        SMTP(Index).SendData "250 ok!" & vbCrLf
        SetLWState Index, "NOOP" & vbCrLf
      Case Else
        SMTP(Index).SendData "503 Unbekanntes Kommando!" & vbCrLf
    End Select
End Function
Function UpdateIcon(Text As String)
    Shell_NotifyIcon NIM_DELETE, TIcon
    
    TIcon.cbSize = Len(TIcon)
    TIcon.hWnd = picTray.hWnd
    TIcon.uId = 1&
    TIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    TIcon.ucallbackMessage = WM_MOUSEMOVE
    TIcon.hIcon = Me.Icon
    TIcon.szTip = "vbInside.de - Mail-Server" & Chr$(13) & Text & _
        Chr$(0)
    
    Shell_NotifyIcon NIM_ADD, TIcon
End Function