frmmain.frm

JK Proxy Project - Version 0.1 ------------------------------ This was going to be a proxy serve

         EndProperty
      EndProperty
   End
   Begin VB.Label lblQuickHelp 
      Height          =   255
      Left            =   120
      TabIndex        =   15
      Top             =   5280
      Width           =   7815
   End
   Begin VB.Menu mnuPopUp 
      Caption         =   "mnuPopUp"
      Begin VB.Menu mnuEditSpam 
         Caption         =   "Edit spam senders"
      End
      Begin VB.Menu mnuSep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuShow 
         Caption         =   "Show config screen"
      End
      Begin VB.Menu mnuSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuStartStop 
         Caption         =   "[start/stop]"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Public Sub ShowMessage(Index As Long, bFullHeader As Boolean, txtbox As TextBox)
' shows a single blocked message

If bFullHeader = False Then
  ' do not show full header, only use Subject, From and Date
  txtbox.Text = "From: " + arrBlocked(Index).strFrom + vbCrLf + _
                 "Subject: " + arrBlocked(Index).strSubject + vbCrLf + _
                 "Date: " + CStr(arrBlocked(Index).dDate) + _
                 vbCrLf + vbCrLf + _
                 arrBlocked(Index).strBody
Else
  txtbox.Text = arrBlocked(Index).strHeader + _
                 vbCrLf + vbCrLf + _
                 arrBlocked(Index).strBody
End If

End Sub

Private Sub chkFullHeader_Click()
' update message
ShowMessage Val(lvBlocked.SelectedItem.SubItems(3)), chkFullHeader, txtShowBlocked
End Sub

Private Sub cmbModule_Click()
Dim i As Long
' hide all frames
For i = frModule.LBound To frModule.UBound
  frModule(i).Visible = False
Next i

' show correct one
Select Case cmbModule.ItemData(cmbModule.ListIndex)
  Case MOD_EMAIL
    frModule(0).Visible = True
End Select

End Sub


Private Sub cmdDiscard_Click()
' discard changes by re-loading settings
LoadConfig

lblRestart = "No"
End Sub

Private Sub cmdEditEmailRules_Click()
' edit email rule file
EditRuleFile strServerDir + "conf\mailrules.conf"
End Sub

Private Sub cmdLoadBlocked_Click()


End Sub

Private Sub cmdIPRules_Click()
' edit IP rule file
EditIPRules strServerDir + "conf\iprules.txt"

End Sub

Private Sub cmdRestart_Click()
' stop server, and restart with next tick
bRestart = True
lblRestart = "No"
StopServer
End Sub

Private Sub cmdSaveSettings_Click()
SaveConfig
End Sub



Private Sub cmdSelSpammers_Click()
CommonDialog1.Filter = "*.*"
CommonDialog1.InitDir = strServerDir + "conf\"
CommonDialog1.ShowOpen

If CommonDialog1.FileName = Empty Then Exit Sub

' save selected file
txtSpammers = CommonDialog1.FileName
SaveSetting APPNAME, SECTION, "spammers", txtSpammers
End Sub

Private Sub cmdShowFull_Click()
Load frmMsgFullscreen

frmMsgFullscreen.Message = Val(lvBlocked.SelectedItem.SubItems(3))
ShowMessage frmMsgFullscreen.Message, False, frmMsgFullscreen.txtShow

frmMsgFullscreen.Show , Me
End Sub

Private Sub cmdStart_Click()
StartServer
End Sub

Private Sub cmdStop_Click()
StopServer
End Sub

Private Sub Command1_Click()
SetTrayIcon

End Sub

Private Sub Command2_Click()
RemoveTrayIcon
End Sub


Private Sub Command3_Click()
TrayIcon.szTip = "Hallo du sack" + vbNullChar
UpdateTrayIcon
End Sub


Private Sub Command4_Click()
Shell Environ$("COMSPEC") + " /c dir>a1234432.txt", vbNormalFocus
End Sub

Private Sub Command5_Click()
SetGUIRunning True
End Sub


Private Sub Command6_Click()

End Sub

Private Sub Form_Load()
Dim i As Long

LoadSettings

'Shell "D:\MyProjects\Proxy\Debug\proxy.exe"

' initialize main tab control
With tabMain.Tabs
  .Clear
  .Add , "server", "Server"
  .Add , "config", "Configuration"
  .Add , "blocked", "Blocked messages"
  .Add , "settings", "Settings"
End With

' initialize module dropdown box
With cmbModule
  .AddItem "eMail proxy"
  .ItemData(.ListCount - 1) = MOD_EMAIL
End With

' initialize listview for blocked messages
With lvBlocked.ColumnHeaders
  .Add , , "From", 150
  .Add , , "Subject", 150
  .Add , , "Date", 120
  .Add , , , 0 ' <- empty, invisible line for storing array index of msg
End With

' remove frames and arrange pictureboxes
For i = picSub.LBound To picSub.UBound
  picSub(i).BorderStyle = 0
  picSub(i).Move 24, 40
Next i

' load main config file
LoadMainConfig

' load settings
LoadConfig

tabMain.Tabs(2).Selected = True
tabMain_Click
cmbModule.ListIndex = 0
mnuPopUp.Visible = False

' set tray icon
SetTrayIcon
' set GUI to 'not running'
SetGUIRunning False

lblRestart.Caption = "No"

LoadMessages "D:\MyProjects\Proxy\Debug\blocked\", arrBlocked
ShowBlockedMessages
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
On Error Resume Next

If x = WM_RBUTTONUP Then
  PopupMenu mnuPopUp
End If

End Sub


Private Sub Form_Resize()
' if minimized -> hide
If Me.WindowState = vbMinimized Then
  Me.Hide
  tmrBlockUpdate.Enabled = False
Else
  tmrBlockUpdate.Enabled = True
End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
' kill log file (if still existing)
On Error Resume Next
Kill App.Path + "\srv_out.txt"
On Error GoTo 0

' kill server (if still running)
If (bIsRunning = True) Then StopServer

' delete tray icon
RemoveTrayIcon


End Sub


Private Sub frModule_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
lblQuickHelp = Empty
End Sub

Private Sub lvBlocked_ItemClick(ByVal Item As MSComctlLib.ListItem)
' show message now
ShowMessage Val(Item.SubItems(3)), chkFullHeader, txtShowBlocked
End Sub


Private Sub mnuEditSpam_Click()
' check if a file is set
If FileExist(txtSpammers) = False Then txtSpammers = Empty

If txtSpammers = Empty Then
  ' no file set
  MsgBox "To use this shortcut please point to the list of spam senders first.", vbInformation
  tabMain.Tabs("settings").Selected = True
  tabMain_Click
Else
  ' ok edit list
  EditList txtSpammers, Nothing
End If
End Sub

Private Sub mnuShow_Click()
Me.WindowState = vbNormal
Me.Show
End Sub

Private Sub mnuStartStop_Click()
' start or stop server
If bIsRunning = False Then
  cmdStart_Click
Else
  cmdStop_Click
End If
End Sub

Private Sub tabMain_Click()
' activate corresponding picturebox
Dim i As Long

' hide all picboxes
For i = picSub.LBound To picSub.UBound
  picSub(i).Visible = False
Next i

' show correct one
Select Case tabMain.SelectedItem.Key
  Case "server"
    picSub(2).Visible = True
  Case "config"
    picSub(0).Visible = True
  Case "blocked"
    picSub(1).Visible = True
  Case "settings"
    picSub(3).Visible = True

End Select
End Sub

Private Sub tmrBlockUpdate_Timer()
ShowBlockedMessages
End Sub

Private Sub tmrCheck_Timer()
' from time to time we need to check if server is still running

If IsWindow(hwndServer) = 0 Then
  ' program was STOPPED
  
  ' protocol...
  AddToProtocol "Server stopped"
  ' status
  SetGUIRunning False
  bIsRunning = False
  ' timer
  tmrCheck.Enabled = False
  
  If bServerTerminate = False Then
    ' server was NOT stopped by user
    Dim strLog As String, pos As Long
    
    ' protocol...
    AddToProtocol "ERROR: abnormal program termination"
    ' now read status_log
    strLog = GetFileCont(App.Path + "\srv_out.txt")
    
    ' find line "Cleaning up... Done"
    pos = InStr(1, strLog, "Cleaning up... Done")
    ' if line is found, cut off
    If pos <> 0 Then
      strLog = Left(strLog, pos - 3)
    End If
    ' now add log to protocol
    AddToProtocol "Server application log:" + vbCrLf + vbCrLf + strLog
    
    ' kill log file
    On Error Resume Next
    Kill App.Path + "\srv_out.txt"
    On Error GoTo 0
  Else
    ' OK, user terminated app
    bServerTerminate = False
    
    ' restart?
    If (bRestart = True) Then
      bRestart = False
      StartServer
    End If
  End If
End If
End Sub

Private Sub txtEmailIPRules_Change()
NeedRestart
End Sub

Private Sub txtEmailIPRules_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
' set quickhelp
lblQuickHelp = EMAIL_IPRULES
End Sub

Private Sub txtEmailKeepTrash_Change()
NeedRestart
End Sub

Private Sub txtEmailKeepTrash_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
' set quickhelp
lblQuickHelp = EMAIL_KEEPBLOCKED
End Sub

Private Sub txtEmailPort_Change()
NeedRestart
End Sub

Private Sub txtEmailPort_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
' set quickhelp
lblQuickHelp = EMAIL_SERVERPORT
End Sub

Private Sub txtEmailRules_Change()
NeedRestart
End Sub

Private Sub txtEmailRules_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
' set quickhelp
lblQuickHelp = EMAIL_RULESFILES
End Sub

Private Sub txtEmailTrash_Change()
NeedRestart
End Sub

Private Sub txtEmailTrash_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
' set quickhelp
lblQuickHelp = EMAIL_TRASHFOLDER
End Sub