frmeditrules.frm

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

        MsgBox "List '" + Mid(arrRules(iCurRule).para(4), 2) + "' is not loaded up to this point. Please select another list"
      Else
        cmbCompare.ListIndex = iSearch
      End If
    End If
    
    ' case sensitive?
    chkSensitive.Value = Abs(LCase(currule.para(3)) = "i")
    
    ' which action?
    If LCase(arrRules(iCurRule).para(5)) = "isspam" Then
      ' block
      optAction(0).Value = True
    Else
      ' pass
      optAction(1).Value = True
    End If
  Else
    ' SIZE RULE
    ' greater? smaller?
    If currule.para(1) = ">" Then
      cmbBigSmall.ListIndex = 0
    Else
      cmbBigSmall.ListIndex = 1
    End If
    ' actual size
    txtBytes = CStr(Val(currule.para(2)))
    
    ' which action?
    If LCase(arrRules(iCurRule).para(3)) = "isspam" Then
      ' block
      optAction(0).Value = True
    Else
      ' pass
      optAction(1).Value = True
    End If
    
  End If


ElseIf currule.rtype = RT_COMMENT Then
  ' comment
  picComment.Visible = True
  ' display comment in textbox
  txtComment = currule.para(0)
  
ElseIf currule.rtype = RT_LOADLIST Then
  ' loadlist
  picLoadList.Visible = True
  txtListName = currule.para(0)
  txtListFile = currule.para(1)
End If
End Sub



Private Sub Preview()
' displays a preview text of the current rule
lblPreview = "Preview: " + GetRuleSentence(BuildRule())
End Sub

Private Sub ShowList()
Dim i As Long, x As ListItem

' iterate through all rules
With lvRules.ListItems
  For i = 1 To cRules
    ' translate rule to natural language and add item
    Set x = .Add
    x.Text = GetRuleSentence(arrRules(i))
    x.SubItems(1) = i
  Next i
End With
End Sub


Private Sub chkSensitive_Click()
Preview
End Sub

Private Sub cmbBigSmall_Click()
Preview
End Sub


Private Sub cmbCompare_Click()
Preview
End Sub


Private Sub cmbCompare_LostFocus()
Preview
End Sub


Private Sub cmbCompareType_Click()
Preview
End Sub


Private Sub cmbHeaderElement_Click()
Preview
End Sub


Private Sub cmbRuleType_Click()
' hide both specific rule panes
picTextCompare.Visible = False
picSizeCompare.Visible = False

Select Case cmbRuleType.ListIndex
  Case 0
    ' header rule
    picTextCompare.Visible = True
    lblHeaderElement.Enabled = True
    cmbHeaderElement.Enabled = True
    
  Case 1
    ' body rule
    picTextCompare.Visible = True
    lblHeaderElement.Enabled = False
    cmbHeaderElement.Enabled = False

  Case 2
    ' email rule
    picTextCompare.Visible = True
    lblHeaderElement.Enabled = False
    cmbHeaderElement.Enabled = False

  Case 3
    ' size rule
    picSizeCompare.Visible = True

End Select

Preview
End Sub


Private Sub cmdAddEntry_Click()
frmAddEntry.Show , Me
End Sub

Private Sub cmdCancel_Click()
lvRules_ItemClick lvRules.SelectedItem
End Sub

Private Sub cmdEditList_Click()
EditList strServerDir + "conf\" + txtListFile, Me
End Sub

Private Sub cmdFSave_Click()
' save rule file
Dim i As Long, j As Long, currule As RULE
Dim FF As Integer
Dim strLine As String

' open file
FF = FreeFile
Open "c:\test.txt" For Output As #FF
' iterate through listview (which contains the correct order)
With lvRules.ListItems
  For i = 1 To .Count
    ' build line
    currule = arrRules(Val(.Item(i).SubItems(1)))
    ' command
    Select Case currule.rtype
      Case RT_COMMENT: strLine = "#"
      Case RT_RULE: strLine = "rule "
      Case RT_LOADLIST: strLine = "loadlist "
    End Select
    ' parameters
    For j = 0 To UBound(currule.para)
      strLine = strLine + currule.para(j)
      
      If j <> UBound(currule.para) Then strLine = strLine + ", "
    
    Next j
    
    
    'If i = 5 Then
    '  MsgBox strLine
    '  MsgBox currule.para(3)
    'End If
    
    ' write line
    Print #FF, strLine
    
  Next i
End With
' close file
Close #FF

Unload Me
NeedRestart
End Sub

Private Sub cmdMoveDown_Click()
Dim x1 As String, x2 As String
Dim i As Long

With lvRules
  ' save selected element
  x1 = .SelectedItem.Text
  x2 = .SelectedItem.SubItems(1)
  i = .SelectedItem.Index
  ' swap
  .SelectedItem.Text = .ListItems(i + 1)
  .SelectedItem.SubItems(1) = .ListItems(i + 1).SubItems(1)
  .ListItems(i + 1).Text = x1
  .ListItems(i + 1).SubItems(1) = x2
  
  .ListItems(i + 1).Selected = True
  
End With

cmdMoveUp.Enabled = (i + 1 > 1)
cmdMoveDown.Enabled = (i + 1 < lvRules.ListItems.Count)
End Sub

Private Sub cmdMoveUp_Click()
Dim x1 As String, x2 As String
Dim i As Long

With lvRules
  ' save selected element
  x1 = .SelectedItem.Text
  x2 = .SelectedItem.SubItems(1)
  i = .SelectedItem.Index
  ' swap
  .SelectedItem.Text = .ListItems(i - 1)
  .SelectedItem.SubItems(1) = .ListItems(i - 1).SubItems(1)
  .ListItems(i - 1).Text = x1
  .ListItems(i - 1).SubItems(1) = x2
  
  .ListItems(i - 1).Selected = True
  
End With

cmdMoveUp.Enabled = (i - 1 > 1)
cmdMoveDown.Enabled = (i - 1 < lvRules.ListItems.Count)
End Sub


Private Sub cmdNewList_Click()
Dim FF As Integer

' select file for new list
CommonDialog1.ShowSave

If CommonDialog1.FileName <> Empty Then
  ' now create empty file
  FF = FreeFile
  Open CommonDialog1.FileName For Output As #FF
  Close #FF
  ' and edit
  EditList CommonDialog1.FileName, Me
End If
End Sub

Private Sub cmdRemoveEntry_Click()
If MsgBox("Are you sure to delete this entry?", vbExclamation + vbYesNo) = vbYes Then
  ' delete from listview
  lvRules.ListItems.Remove lvRules.SelectedItem.Index
  cmdRemoveEntry.Enabled = False
  ' no need to delete item from array
End If
End Sub

Private Sub cmdSave_Click()
' generate rule and save
arrRules(iCurRule) = BuildRule

' update listview
lvRules.SelectedItem.Text = GetRuleSentence(arrRules(iCurRule))
' update edit pane
lvRules_ItemClick lvRules.SelectedItem

End Sub

Private Sub cmdSelectList_Click()
' show dialog to select list
CommonDialog1.InitDir = strServerDir + "\conf"
CommonDialog1.ShowOpen

If CommonDialog1.FileName <> Empty Then
  ' file must be in config dir (or subdir)
  If LCase(Left(CommonDialog1.FileName, Len(strServerDir + "conf"))) <> (LCase(strServerDir + "conf")) Then
    MsgBox "File must be in configuration directory \conf or in one of it's subdirectories", vbExclamation
  Else
    txtListFile = Mid(CommonDialog1.FileName, Len(strServerDir + "conf") + 2)
  End If
End If

Preview
End Sub

Private Sub Command1_Click()
MsgBox GetRuleSentence(BuildRule())
End Sub

Private Sub Command2_Click()

End Sub

Private Sub Form_Load()
' initialize listview
With lvRules.ColumnHeaders
  .Add , , "Rule", lvRules.Width - 26
  .Add , , "Index", 0
End With

' initialize combo-box
With cmbRuleType
  .AddItem "Header"
  .AddItem "Body"
  .AddItem "Sender's email"
  .AddItem "Message size"
End With

' initialize config panes
picRule.BorderStyle = 0
picRule.Move 20, 232
picRule.Visible = False
picComment.BorderStyle = 0
picComment.Move 20, 232
picComment.Visible = False
picLoadList.BorderStyle = 0
picLoadList.Move 20, 232
picLoadList.Visible = False

picTextCompare.BorderStyle = 0
picSizeCompare.BorderStyle = 0

' initialize list of header elements
With cmbHeaderElement
  .AddItem "Subject"
  .AddItem "From"
End With
' initialize types of comparison
With cmbCompareType
  .AddItem "contains"
  .AddItem "does not contain"
  .AddItem "equals"
  .AddItem "does not equal"
  .AddItem "pattern-matches"
  .AddItem "does not pattern-match"
End With
' initialize size comparison
With cmbBigSmall
  .AddItem "smaller than"
  .AddItem "bigger that"
End With

lblPreview.Caption = Empty

End Sub

Private Sub lvRules_ItemClick(ByVal Item As MSComctlLib.ListItem)
' load selected rule
iCurRule = Val(Item.SubItems(1))
LoadListList
LoadRule iCurRule

Frame1.Enabled = True
cmdCancel.Enabled = True
cmdSave.Enabled = True

cmdMoveUp.Enabled = (Item.Index > 1)
cmdMoveDown.Enabled = (Item.Index < lvRules.ListItems.Count)
cmdRemoveEntry.Enabled = True

End Sub


Private Sub optAction_Click(Index As Integer)
Preview
End Sub

Private Sub optCompare_Click(Index As Integer)
cmbCompare.Visible = False
txtCompare.Visible = False

cmbCompare.Visible = (Index = 1)
txtCompare.Visible = Not cmbCompare.Visible

Preview
End Sub


Private Sub txtBytes_Change()
txtBytes = CStr(Val(txtBytes))


End Sub

Private Sub txtBytes_LostFocus()
Preview
End Sub


Private Sub txtComment_Change()
Preview
End Sub

Private Sub txtListName_Change()
Preview
End Sub