frmclient.frm

基于C-S结构的办公信息数据处理系。经检测绝对可用。类似OutLook界面。

            .Label3.FontBold = False
            .Show
        End With
Else
MsgBox "Error With Message Content", vbExclamation + vbOKOnly
End If
End With

Set itm = Nothing
'Set LvMessage = Nothing
Set FrmNew = Nothing

End Sub

Private Sub mnu3Open_Click()
Call MsOpen
End Sub

Private Sub mnu3Print_Click()
Call PrintFrm
End Sub



Private Sub mnu4EmailAcc_Click()
FrmConnect.Usersock.SendData "GetMailAcc" & FrmConnect.strUserName
End Sub

Private Sub mnu4Reindex_Click()
FrmConnect.Usersock.SendData "ComData" & FrmConnect.strUserName
MsgBox "Database Compressed", vbInformation

End Sub

Private Sub MnuDelFolder_Click()
With FrmConnect.Usersock
    If Not .State = sckClosed Then _
    .SendData "DeleteFolder" & Chr(10) & FrmMain.TVdir.SelectedItem.Text
    MousePointer = 11
End With

End Sub

Private Sub MnuInfo_Click()
FrmConnect.Usersock.SendData "GetInfo" & FrmConnect.strUserName & Chr(10) & TVcontact.SelectedItem.Text
End Sub

Private Sub mnuNew_Click()
TVcontact_DblClick
End Sub

Private Sub MnuNewFold_Click()
Call newFolder
End Sub

Public Sub mnuRefresh_Click()
On Error Resume Next
LvMail.ListItems.Clear
TVcontact.Nodes.Clear
TVdir.Nodes.Clear
FrmConnect.Usersock.SendData "GetUserList" & FrmConnect.strUserName
Statusbar = 4
End Sub

Private Sub mnuReply_Click()
Call Reply
End Sub
Private Sub RichTextBox1_Click()
'If RichTextBox1.Text = "" Then Exit Sub
'Call Reply
End Sub




Private Sub RichTextBox1_GotFocus()
Frame1.BackColor = &H700000
Label4.BackColor = &H700000
Label3.BackColor = &H700000
Label6.BackColor = &H700000
Label1.BackColor = &H700000
Label2.BackColor = &H700000
Label5.BackColor = &H700000
Frame1.BorderStyle = 0
Label1.ForeColor = vbWhite
Label2.ForeColor = vbWhite
Label5.ForeColor = vbWhite

Label4.ForeColor = vbWhite
Label3.ForeColor = vbWhite
Label6.ForeColor = vbWhite

End Sub

Private Sub RichTextBox1_LostFocus()
Frame1.BackColor = vbButtonFace
Label4.BackColor = vbButtonFace
Label3.BackColor = vbButtonFace
Label6.BackColor = vbButtonFace
Label1.BackColor = vbButtonFace
Label2.BackColor = vbButtonFace
Label5.BackColor = vbButtonFace
Frame1.BorderStyle = 1
Label1.ForeColor = &H0&
Label2.ForeColor = &H0&
Label5.ForeColor = &H0&

Label4.ForeColor = &H0&
Label3.ForeColor = &H0&
Label6.ForeColor = &H0&

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

Select Case Button.Index

Case 1: Call CreateNew
Case 3: Call ItmDelete
Case 5: Call Reply
Case 7: FrmConnect.WindowState = vbNormal
Case 9: Call PrintFrm
Case 11: mnuRefresh_Click
Case 13: Call GetOptions
End Select
End Sub

Private Sub GetConnection()
Dim strAuthen As PwSettings
Set strAuthen = New PwSettings
Dim NewCon As FrmConnect
Set NewCon = FrmConnect
If FrmConnect.WindowState = vbMinimized Then _
FrmConnect.WindowState = vbNormal

With NewCon
        If strAuthen.SavePass = True Then
        .Check1.Value = 1
        Else
        .Check1.Value = 0
    End If
    
    If strAuthen.Autocon = True Then
        .Check2.Value = 1
        .AutoConnect = True
        Else
        .Check2.Value = 0
        .AutoConnect = False
    End If
    
    DataRecieve.Status = 0               'Clear the status description
    .Text1(0).Text = strAuthen.UserName
    .Text1(1).Text = strAuthen.Password
    .Text1(1).SelStart = 0
    .Text1(1).SelLength = Len(.Text1(1).Text)
    .Text1(2).Text = strAuthen.ServerIP
    .Show
    If .AutoConnect = True Then .cmdcon = True
End With

Set NewCon = Nothing
Set strAuthen = Nothing

End Sub

Public Sub CreateNew()
Dim FormMsg As FrmNew
Set FormMsg = New FrmNew
Dim i As Integer
    With FormMsg
         For i = 0 To UBound(Split(AllUsersList, "_")) - 1
        .Combo1.AddItem Split(AllUsersList, "_")(i)
         Next i
            .mnuNew.Enabled = False
            .mnuSave.Enabled = False
            .MnuDelete.Enabled = False
            .mnuMove.Enabled = False
            .Combo1.AddItem ""
            .Text1(0).Text = FrmConnect.strUserName
            .Text1(1).Text = ""
            .RichTextBox1.Text = ""
            .Toolbar1.Buttons(4).Enabled = False
           
        .Show
    End With
Set FormMsg = Nothing
End Sub

Public Sub DisControls(Disable As Boolean)
With Toolbar1.Buttons
If Disable = True Then
FrmMain.LvMail.ColumnHeaders.Clear
    .Item(1).Enabled = False
    .Item(2).Enabled = False
    .Item(3).Enabled = False
    .Item(4).Enabled = False
    .Item(5).Enabled = False
    .Item(6).Enabled = False
    .Item(8).Enabled = False
    .Item(9).Enabled = False
    .Item(11).Enabled = False
    Label3.Caption = ""
    Label4.Caption = ""
    Label6.Caption = ""
    RichTextBox1.Text = ""
    TVdir.Enabled = False
    TVcontact.Enabled = False
    RichTextBox1.Enabled = False
    LvMail.Enabled = False
    LvMail.View = lvwList
    .Item(6).Image = 10

Else
Call lvcolumns          'create columns headers

    .Item(1).Enabled = True
    .Item(2).Enabled = True
    .Item(3).Enabled = True
    .Item(4).Enabled = True
    .Item(5).Enabled = True
    .Item(6).Enabled = True
    .Item(8).Enabled = True
    .Item(9).Enabled = True
    .Item(11).Enabled = True
    .Item(6).Image = 4

    TVdir.Enabled = True
    TVcontact.Enabled = True
    RichTextBox1.Enabled = True
    LvMail.Enabled = True
    StatusBar1.Panels.Item(2).Text = "Logged in: " & FrmConnect.strUserName

End If
End With
End Sub

Private Sub TVcontact_DblClick()
If InStr(1, TVcontact.SelectedItem.Text, "[") = 1 Then _
Exit Sub
Dim i As Integer
Dim NewMessage As FrmNew
Set NewMessage = New FrmNew

With NewMessage
    
On Error Resume Next
    For i = 0 To UBound(Split(AllUsersList, "_")) - 1
        .Combo1.AddItem Split(AllUsersList, "_")(i)
    Next i
        .mnuNew.Enabled = False
        .mnuSave.Enabled = False
        .MnuDelete.Enabled = False
        .mnuMove.Enabled = False
        .Combo1.Text = TVcontact.SelectedItem.Text
        .Combo1.AddItem ""
        .Text1(0).Text = FrmConnect.strUserName
        .Text1(1).Text = ""
        .RichTextBox1.Text = ""
        .Text1(1).TabIndex = 0
        .RichTextBox1.TabIndex = 1
        .Toolbar1.Buttons(4).Enabled = False
    
        .Show
    
End With

Set NewMessage = Nothing



End Sub

Private Sub TVcontact_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF5 Then mnuRefresh_Click

End Sub

Private Sub TVcontact_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
PopupMenu Menu1
End If
End Sub

Private Sub TVdir_Click()
On Error Resume Next
Dim i As Integer
   
    With TVdir
        If Selected = .Nodes.Item(.SelectedItem.Index).Text Then
            Exit Sub
        Else
            Selected = .SelectedItem.Text
        End If
    End With
    
    For i = 0 To TVdir.Nodes.Count
        TVdir.Nodes(i).Bold = False
    Next i
   
If Selected = "[Personal Folders]" Then Exit Sub
If Selected = "Inbox" Then Me.Caption = "  Inbox Folder - " & "Office Messenger" Else Me.Caption = "  " & Selected & " - Office Messenger"
If Selected = "Inbox" Then Label9 = "  Inbox Folder" Else Label9 = "  " & Selected

With TVdir.SelectedItem
       .Bold = True
    If .Text = "Inbox" Then
        Call GetUserMessages("Discription")
         FrmMain.strMessage = ""
        Exit Sub
    End If


Call FrmMain.RemoveIcon
Call GetUserMessages(.Text)
End With
End Sub

Private Sub TVdir_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF5 Then mnuRefresh_Click

End Sub

Private Sub TVdir_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
    With TVdir.SelectedItem
        If .Text = "Rubbish Bin" Then Mnu2Rubbish.Visible = True Else Mnu2Rubbish.Visible = False
        If Not .Text = "Rubbish Bin" Or .Text = "[Personal Folders]" Or .Text = "Inbox" Then MnuDelFolder.Caption = "&Delete " & "'" & .Text & "'"
        If .Text = "Rubbish Bin" Or .Text = "[Personal Folders]" Or .Text = "Inbox" Or .Text = "Sent Items" Then MnuDelFolder.Visible = False Else MnuDelFolder.Visible = True
        
    End With
PopupMenu Menu2

End If

End Sub
Private Sub TVdir_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call DragFolder
End Sub
Public Sub DragFolder()
Dim GetFolders As FrmDrop
Set GetFolders = New FrmDrop
Dim TvFolder As Node
Dim i As Integer
    With GetFolders.TVdir
        .Nodes.Clear
        Set TvFolder = .Nodes.Add(, tvwFirst, , "[Personal Folders]", 3)
        Set TvFolder = .Nodes.Add(TvFolder, tvwChild, , "Inbox", 2)
            .Nodes.Item(1).Expanded = True
    

        For i = 3 To TVdir.Nodes.Count
            If TVdir.Nodes.Item(i).Text = "Rubbish Bin" Then
                Set TvFolder = .Nodes.Add(TvFolder, tvwNext, , TVdir.Nodes.Item(i).Text, 4)
                     GoTo nextI
            End If
           
            Set TvFolder = .Nodes.Add(TvFolder, tvwNext, , TVdir.Nodes.Item(i).Text, 2)
nextI:

        Next i
    End With
GetFolders.Message = DragMessage 'copy the message to the frmdrop form
GetFolders.Show 1


Set GetFolders = Nothing

End Sub
Public Sub Reply()
Dim replyMessage As FrmNew
Dim LvMessage As MsgLayout
Dim itm As ListItem
Dim i As Integer
On Error GoTo skipload
Set replyMessage = New FrmNew
'Set LvMessage = New MsgLayout

With replyMessage
    For i = 0 To UBound(Split(AllUsersList, "_")) - 1
            .Combo1.AddItem Split(AllUsersList, "_")(i)
                Next i
    Set itm = LvMail.ListItems.Item(LvMail.SelectedItem.Index)
    Lvstore.GetMsgStore (LvMail.SelectedItem.Text)
    .Combo1.AddItem itm.SubItems(1)
    .Combo1.Text = itm.SubItems(1)
    .Label4.Caption = itm.SubItems(3)
    .Text1(0).Text = FrmConnect.strUserName
    If InStr(1, itm.SubItems(2), "RE:", vbTextCompare) = 1 Then
        .Text1(1).Text = itm.SubItems(2)
            Else
        .Text1(1).Text = "RE: " & itm.SubItems(2)
    End If
    .Toolbar1.Buttons(4).Enabled = False
    .RichTextBox1.Text = Split(Lvstore.SendMessageID, "[~N10~]")(0)
    .RichTextBox1.Text = vbNewLine & vbNewLine & "------Original Message------ " & _
    vbNewLine & "From: " & itm.SubItems(1) & vbNewLine & "Sent: " & Format(itm.SubItems(3), "Long Date") & _
    vbNewLine & "To: " & itm.SubItems(1) & vbNewLine & "Subject: " & itm.SubItems(2) & _
    vbNewLine & vbNewLine & RichTextBox1.Text
    .RichTextBox1.TabIndex = 0
    .Show


End With
'Set LvMessage = Nothing
Set replyMessage = Nothing
Exit Sub
skipload:
MsgBox "Error with message, it may not exist, or is corrupted", vbExclamation + vbOKOnly, "Get Message Error"

'Set LvMessage = Nothing
Set replyMessage = Nothing
End Sub

Public Sub PrintFrm()
Dim FrmPrinter As FrmPrint
Set FrmPrinter = New FrmPrint
'Dim LvMessage As MsgLayout
'Set LvMessage = New MsgLayout
Dim itm As ListItem

Set itm = LvMail.ListItems.Item(LvMail.SelectedItem.Index)
    Lvstore.GetMsgStore (LvMail.SelectedItem.Text)
        FrmPrinter.Label1.Caption = itm.SubItems(1)
        FrmPrinter.Label2.Caption = "Subject: " & itm.SubItems(2)
        FrmPrinter.RichTextBox1.Text = Split(Lvstore.SendMessageID, "[~N10~]")(0)
        Const ErrCancel = 32755
            PrintDiag.CancelError = True
            
            On Error GoTo errorPrinter
                PrintDiag.Flags = 64
                PrintDiag.ShowPrinter
                FrmPrinter.PrintForm

        Set FrmPrinter = Nothing
       ' Set Lvstore = Nothing

errorPrinter:
            If Err = ErrCancel Then
        
        
    Set FrmPrinter = Nothing
    'Set Lvstore = Nothing
        Exit Sub
            End If
End Sub

Private Sub GetOptions()
FrmOptions.Show 1

End Sub

Public Sub FrmStyle()
Mnu0Preview.Checked = False
HiddenPreview = True
Frame1.Visible = False
HSplit.Visible = False
RichTextBox1.Visible = False
LvMail.Height = FrmMain.Height - 2340
Shape1.Height = FrmMain.Height - 2340

End Sub