frmNetMessage.frm

 VERSION 5.00
Begin VB.Form frmNetMessage
   AutoRedraw      =   -1  'True
   BorderStyle     =   0  'None
   ClientHeight    =   7665
   ClientLeft      =   0
   ClientTop       =   -45
   ClientWidth     =   7110
   Icon            =   "frmNetMessage.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7665
   ScaleWidth      =   7110
   ShowInTaskbar   =   0   'False
   Begin VB.PictureBox picTemplateFrame
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   315
      Left            =   210
      ScaleHeight     =   285
      ScaleWidth      =   6630
      TabIndex        =   16
      TabStop         =   0   'False
      Top             =   3165
      Width           =   6660
      Begin VB.ComboBox cboTemplateMessages
         Appearance      =   0  'Flat
         BackColor       =   &H00C0C0C0&
         BeginProperty Font
            Name            =   "Arial"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   345
         Left            =   -30
         Sorted          =   -1  'True
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   -30
         Width           =   6690
      End
   End
   Begin ChatTool.bgDugme bgCmdSelectedRight
      Height          =   390
      Left            =   3345
      TabIndex        =   4
      Top             =   4455
      Width           =   390
      _ExtentX        =   688
      _ExtentY        =   688
      Caption         =   ">"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin ChatTool.bgFrame bgFrameReceivers
      Height          =   2835
      Left            =   3780
      Top             =   3585
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   5001
      Caption         =   "Receivers"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Begin VB.ListBox lstReceivers
         Appearance      =   0  'Flat
         BackColor       =   &H00C0C0C0&
         BeginProperty Font
            Name            =   "Arial"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   2280
         Left            =   180
         MultiSelect     =   2  'Extended
         Sorted          =   -1  'True
         TabIndex        =   8
         Top             =   375
         Width           =   2760
      End
   End
   Begin ChatTool.bgFrame bgFrameUsers
      Height          =   2835
      Left            =   165
      Top             =   3585
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   5001
      Caption         =   "Users"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Begin VB.PictureBox picUsersFrame
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         ForeColor       =   &H80000008&
         Height          =   315
         Left            =   180
         ScaleHeight     =   285
         ScaleWidth      =   2745
         TabIndex        =   15
         TabStop         =   0   'False
         Top             =   390
         Width           =   2775
         Begin VB.ComboBox cboGroup
            Appearance      =   0  'Flat
            BackColor       =   &H00C0C0C0&
            BeginProperty Font
               Name            =   "Arial"
               Size            =   9
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   345
            Left            =   -30
            Sorted          =   -1  'True
            Style           =   2  'Dropdown List
            TabIndex        =   2
            Top             =   -30
            Width           =   2820
         End
      End
      Begin VB.ListBox lstUsers
         Appearance      =   0  'Flat
         BackColor       =   &H00C0C0C0&
         BeginProperty Font
            Name            =   "Arial"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1830
         ItemData        =   "frmNetMessage.frx":08CA
         Left            =   180
         List            =   "frmNetMessage.frx":08D1
         MultiSelect     =   2  'Extended
         Sorted          =   -1  'True
         TabIndex        =   3
         Top             =   825
         Width           =   2760
      End
   End
   Begin ChatTool.bgDugme bgCmdSend
      Height          =   450
      Left            =   1275
      TabIndex        =   10
      Top             =   6990
      Width           =   1515
      _ExtentX        =   2672
      _ExtentY        =   794
      Caption         =   "&Send message"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin VB.TextBox txtMessage
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2145
      Left            =   210
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   660
      Width           =   6645
   End
   Begin ChatTool.bgDugme bgCmdCancel
      Height          =   450
      Left            =   4605
      TabIndex        =   12
      Top             =   6990
      Width           =   1515
      _ExtentX        =   2672
      _ExtentY        =   794
      Caption         =   "&Cancel"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin ChatTool.bgDugme bgCmdGetLast
      Height          =   450
      Left            =   2933
      TabIndex        =   11
      Top             =   6990
      Width           =   1515
      _ExtentX        =   2672
      _ExtentY        =   794
      Caption         =   "&Get last"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin ChatTool.bgCheck bgChkAddReceivers
      Height          =   240
      Left            =   1980
      TabIndex        =   9
      Top             =   6555
      Width           =   3390
      _ExtentX        =   5980
      _ExtentY        =   423
      Caption         =   "Add list of receivers to the message"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin ChatTool.bgDugme bgCmdAllRight
      Height          =   390
      Left            =   3345
      TabIndex        =   5
      Top             =   4890
      Width           =   390
      _ExtentX        =   688
      _ExtentY        =   688
      Caption         =   ">>"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin ChatTool.bgDugme bgCmdSelectedLeft
      Height          =   390
      Left            =   3345
      TabIndex        =   6
      Top             =   5340
      Width           =   390
      _ExtentX        =   688
      _ExtentY        =   688
      Caption         =   "<"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin ChatTool.bgDugme bgCmdAllLeft
      Height          =   390
      Left            =   3345
      TabIndex        =   7
      Top             =   5760
      Width           =   390
      _ExtentX        =   688
      _ExtentY        =   688
      Caption         =   "<<"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Object.Width           =   -1
   End
   Begin VB.Label lblMessage
      BackStyle       =   0  'Transparent
      Caption         =   "Message:"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   270
      Left            =   225
      TabIndex        =   14
      Top             =   405
      Width           =   1065
   End
   Begin VB.Label lblTemplateMessages
      Caption         =   "Template messages:"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   270
      Left            =   210
      TabIndex        =   13
      Top             =   2880
      Width           =   2100
   End
End
Attribute VB_Name = "frmNetMessage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Aktiv As Boolean
Private WithEvents cmdClose As VBControlExtender
Attribute cmdClose.VB_VarHelpID = -1
Private intLastSendPeopleCount As Integer
Private Type LastSendPeopleStructure
    Fullname As String
    Index As Integer
End Type
Private lastSendPeople() As LastSendPeopleStructure
Private strLastSendText As String
Private blnLastSendIsAddRecieversListMarked As Boolean
Private strLastSendGroupName As String
Private strTmpText As String
Private Type udtUser
    Group As String
    Username As String
    Fullname As String
    Selected As Boolean
    Online As Boolean
End Type
Private NetUserArray() As udtUser
Private intNetUserArrayCount As Integer
Private blnOnlineUsersSelected As Boolean

Private Sub bgCmdAllLeft_Click()
    Dim i As Integer
    For i = 0 To lstReceivers.ListCount - 1
        If NetUserArray(lstReceivers.ItemData(0)).Group = cboGroup.Text Or _
            NetUserArray(lstReceivers.ItemData(0)).Online And blnOnlineUsersSelected Then
                lstUsers.AddItem lstReceivers.List(0)
                lstUsers.ItemData(lstUsers.NewIndex) = lstReceivers.ItemData(0)
        End If
        NetUserArray(lstReceivers.ItemData(0)).Selected = False
        lstReceivers.RemoveItem (0)
    Next i
End Sub

Private Sub bgCmdSelectedLeft_Click()
    Dim i As Integer
    i = 0
    While i < lstReceivers.ListCount
        If lstReceivers.Selected(i) Then
            If NetUserArray(lstReceivers.ItemData(i)).Group = cboGroup.Text Or _
                NetUserArray(lstReceivers.ItemData(i)).Online And blnOnlineUsersSelected Then
                    lstUsers.AddItem lstReceivers.List(i)
                    lstUsers.ItemData(lstUsers.NewIndex) = lstReceivers.ItemData(i)
            End If
            NetUserArray(lstReceivers.ItemData(i)).Selected = False
            lstReceivers.RemoveItem i
        Else
            i = i + 1
        End If
    Wend
End Sub

Private Sub bgCmdSelectedRight_Click()
    Dim i As Integer
    i = 0
    While i < lstUsers.ListCount
        If lstUsers.Selected(i) Then
            lstReceivers.AddItem lstUsers.List(i)
            lstReceivers.ItemData(lstReceivers.NewIndex) = lstUsers.ItemData(i)
            NetUserArray(lstUsers.ItemData(i)).Selected = True
            lstUsers.RemoveItem (i)
        Else
            i = i + 1
        End If
    Wend
End Sub

Private Sub bgCmdAllRight_Click()
Dim i As Integer
    For i = 0 To lstUsers.ListCount - 1
        lstReceivers.AddItem lstUsers.List(0)
        lstReceivers.ItemData(lstReceivers.NewIndex) = lstUsers.ItemData(0)
        NetUserArray(lstUsers.ItemData(0)).Selected = True
        lstUsers.RemoveItem (0)
    Next i
End Sub

Private Sub bgCmdGetLast_Click()
On Error GoTo err:
    Dim i As Integer

    cboTemplateMessages.ListIndex = 0
    For i = 0 To lstReceivers.ListCount - 1
        NetUserArray(lstReceivers.ItemData(i)).Selected = False
    Next i
    lstReceivers.Clear
    For i = 0 To intLastSendPeopleCount - 1
        lstReceivers.AddItem lastSendPeople(i).Fullname, i
        lstReceivers.ItemData(i) = lastSendPeople(i).Index
        NetUserArray(lstReceivers.ItemData(i)).Selected = True
    Next i
   
    If blnLastSendIsAddRecieversListMarked Then
        bgChkAddReceivers.value = True
    Else
        bgChkAddReceivers.value = False
    End If
   
    If strLastSendGroupName = "" Then
        cboGroup.Text = cboGroup.Text 'To refresh
    Else
        cboGroup.Text = strLastSendGroupName
    End If

    txtMessage.Text = strLastSendText

    txtMessage.SetFocus
    txtMessage.SelStart = 0
    txtMessage.SelLength = Len(txtMessage.Text)
    Exit Sub
err:
    DebugLog "ERR - frmSenMessage - bgCmdGetLast_Click = " & err.Description & " - " & err.Number
End Sub

Private Sub cboGroup_click()
On Error GoTo err:
Dim i As Integer
Dim pos As Integer
    lstUsers.Clear
    strTmpText = GetText(1230) 'Text: Online users
    If cboGroup.Text = strTmpText Then
        blnOnlineUsersSelected = True
        ListOnlinePeople
    Else
        blnOnlineUsersSelected = False
        For i = 0 To intNetUserArrayCount - 1
            If NetUserArray(i).Group = cboGroup.Text And Not NetUserArray(i).Selected Then
               lstUsers.AddItem NetUserArray(i).Fullname
               lstUsers.ItemData(lstUsers.NewIndex) = i
            End If
        Next i
    End If
    Exit Sub
err:
    DebugLog "ERR - frmNetMessage - cboGroup_click = " & err.Description & " - " & err.Number
End Sub

Private Sub cmdClose_ObjectEvent(Info As EventInfo)
    If Info = "Klik" Then Unload Me
End Sub

Private Sub Form_activate()
    If Aktiv = False Then
        Aktiv = True
        LoadSkin Me, Active, True, LoadIt, 1
    Else
        LoadSkin Me, Active, False, LoadIt
    End If
    txtMessage.SetFocus
End Sub

Private Sub Form_Deactivate()
    LoadSkin Me, NeActive, False, LoadIt
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo err:
    Select Case KeyCode
        Case vbKeyEscape:
            Me.Hide
    End Select
    Exit Sub
err:
    DebugLog "ERR - frmNetMessage - Form_KeyDown = " & err.Description & " - " & err.Number
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        If y <= intCloseHeight And x < intCloseLeft Then
            WindowMove Me
        End If
    End If
    If Screen.MousePointer <> vbDefault Then Screen.MousePointer = vbDefault
End Sub

Private Sub cboTemplateMessages_Click()
    txtMessage.Text = cboTemplateMessages.Text
End Sub

Private Sub bgCmdCancel_Click()
    Dim i As Integer
    For i = 0 To lstReceivers.ListCount - 1
        NetUserArray(lstReceivers.ItemData(i)).Selected = False
    Next i
    lstReceivers.Clear
    txtMessage.Text = ""
    Me.Hide
End Sub

Private Sub bgCmdSend_Click()
On Error GoTo err:
    Dim i As Integer
    Dim strReceivers As String
    Dim strMessage As String
   
    If txtMessage.Text = "" Then
        strTmpText = GetText(1233) 'Text: The message is empty!
        frmChatTool.MessageBox.MsgBox Me, strTmpText, vbExclamation
        Exit Sub
    End If
   
    If bgChkAddReceivers.value = True Then
        For i = 0 To lstReceivers.ListCount - 1
            strReceivers = strReceivers & vbCr & lstReceivers.List(i)
        Next i
        blnLastSendIsAddRecieversListMarked = True
    Else
        blnLastSendIsAddRecieversListMarked = False
    End If
   
    strTmpText = GetText(1231) 'Text: Message send from ChatTool by
   
    strMessage = " ********** " & strTmpText & " " & IIf(frmChatTool.strFullName <> "", frmChatTool.strFullName, frmChatTool.strUserName) _
        & " **********" & vbCr & vbCr & Replace(txtMessage.Text, vbCrLf, vbCr) & vbCr & vbCr
   
    If bgChkAddReceivers.value = True Then
        strTmpText = GetText(1232) 'Text: Receivers
        strMessage = strMessage & "**** " & strTmpText & " ****" & strReceivers
    End If

    strLastSendText = txtMessage.Text
    strLastSendGroupName = cboGroup.Text
   
    txtMessage.Text = ""
    intLastSendPeopleCount = 0
    ReDim lastSendPeople(lstReceivers.ListCount)
    For i = 0 To lstReceivers.ListCount - 1
        intLastSendPeopleCount = intLastSendPeopleCount + 1
        lastSendPeople(intLastSendPeopleCount - 1).Fullname = lstReceivers.List(i)
        lastSendPeople(intLastSendPeopleCount - 1).Index = lstReceivers.ItemData(i)
        Shell "net send " & NetUserArray(lstReceivers.ItemData(i)).Username & " " & strMessage, vbHide
    Next i
   
    If CtrlKeyPressed() Then
        txtMessage.SetFocus
    Else
        bgCmdAllLeft_Click
        Me.Hide
    End If
    Exit Sub
err:
    DebugLog "ERR - frmNetMessage - bgCmdSend_Click = " & err.Description & " - " & err.Number
End Sub

Private Sub Form_Load()
On Error GoTo err:
    Aktiv = False
    Set cmdClose = Me.Controls.Add("ChatTool.bgclose", "cmdClose")
    cmdClose.Visible = True
   
    Me.Left = frmChatTool.Left + Int((frmChatTool.Width - Me.Width) / 2)
    Me.Top = frmChatTool.Top + Int((frmChatTool.Height - Me.Height) / 2)
   
    txtMessage.BackColor = Title.txtUnlockedColor
    cboTemplateMessages.BackColor = Title.txtUnlockedColor
    lblTemplateMessages.BackColor = Title.BackColor
    lstUsers.BackColor = Title.ColorB
    lstReceivers.BackColor = Title.ColorB
    cboGroup.BackColor = Title.txtUnlockedColor
   
    LoadDataFile
   
    strTmpText = GetText(1230) 'Text: Online users
    cboGroup.AddItem strTmpText
  
    frmChatTool.blnMessageFormLoaded = True
  
    LoadGUIText
   
    Exit Sub
err:
    DebugLog "ERR - frmNetMessage - Form_load = " & err.Description & " - " & err.Number
End Sub

Public Sub ChangeLanguage()
    cboGroup.Clear
    LoadDataFile
    strTmpText = GetText(1230) 'Text: Online users
    cboGroup.AddItem strTmpText
    LoadGUIText
End Sub

Private Sub LoadGUIText()
    Me.Caption = GetText(1200) 'Text: ChatTool - Send message
    lblMessage.Caption = GetText(1201) 'Text: Message:
    bgCmdSend.Caption = GetText(1206) 'Text: &Send message
    bgCmdGetLast.Caption = GetText(1207) 'Text: &Get last
    bgCmdCancel.Caption = GetText(1208) 'Text: &Cancel
    lblTemplateMessages.Caption = GetText(1202)  'Text: Template messages:
    bgFrameUsers.Caption = GetText(1203)   'Text: Users
    bgFrameReceivers.Caption = GetText(1204) 'Text: Receivers
    bgChkAddReceivers.Caption = GetText(1205) 'Text: Add list of receivers to message
End Sub

Public Sub Init()
On Error GoTo err:
    Dim i As Integer
    Dim j As Integer
    Dim Index As Integer
    Dim strLocUserName As String
    Dim strLocFullname As String
    Dim intPos As Integer
   
    Me.Left = frmChatTool.Left + Int((frmChatTool.Width - Me.Width) / 2)
    Me.Top = frmChatTool.Top + Int((frmChatTool.Height - Me.Height) / 2)
   
    strTmpText = GetText(1230) 'Text: Online users
    cboGroup.Text = strTmpText
 
    lstReceivers.Clear
    lstUsers.Clear
    For i = 0 To frmChatTool.lstConnections.ListCount - 1
        If i = 0 Then
            frmChatTool.GetFirstOnlineUser strLocUserName, strLocFullname
        Else
            frmChatTool.GetNextOnlineUser strLocUserName, strLocFullname
        End If
   
        intPos = PositionInNetUserArray(strLocUserName)
        If intPos <> -1 Then
            NetUserArray(intPos).Online = True
            If frmChatTool.lstConnections.Selected(i) Then
                lstReceivers.AddItem NetUserArray(intPos).Fullname
                lstReceivers.ItemData(lstReceivers.NewIndex) = intPos
                NetUserArray(intPos).Selected = True
            Else
                lstUsers.AddItem NetUserArray(intPos).Fullname
                lstUsers.ItemData(lstUsers.NewIndex) = intPos
                NetUserArray(intPos).Selected = False
            End If
        Else
            If intNetUserArrayCount >= UBound(NetUserArray()) Then
                ReDim Preserve NetUserArray(intNetUserArrayCount + 50)
            End If
            NetUserArray(intNetUserArrayCount).Username = strLocUserName
            NetUserArray(intNetUserArrayCount).Fullname = strLocFullname
            NetUserArray(intNetUserArrayCount).Online = True
            NetUserArray(intNetUserArrayCount).Group = ""
            If frmChatTool.lstConnections.Selected(i) Then
                lstReceivers.AddItem NetUserArray(intNetUserArrayCount).Fullname
                lstReceivers.ItemData(lstReceivers.NewIndex) = intNetUserArrayCount
                NetUserArray(intNetUserArrayCount).Selected = True
            Else
                lstUsers.AddItem NetUserArray(intNetUserArrayCount).Fullname
                lstUsers.ItemData(lstUsers.NewIndex) = intNetUserArrayCount
                NetUserArray(intNetUserArrayCount).Selected = False
            End If
            intNetUserArrayCount = intNetUserArrayCount + 1
        End If
    Next i
    cboTemplateMessages.ListIndex = 0
    bgChkAddReceivers.value = False
    Exit Sub
err:
    DebugLog "ERR - frmNetMessage - Init = " & err.Description & " - " & err.Number
End Sub

Private Function PositionInNetUserArray(strUserName As String) As Integer
Dim i As Integer

    For i = 0 To intNetUserArrayCount - 1
        If strUserName = NetUserArray(i).Username Then
            PositionInNetUserArray = i
            Exit Function
        End If
    Next i
   
    PositionInNetUserArray = -1
   
End Function

Private Sub ListOnlinePeople()
On Error GoTo err:
    Dim i As Integer
    lstUsers.Clear
    For i = 0 To intNetUserArrayCount - 1
        If NetUserArray(i).Online And Not NetUserArray(i).Selected Then
            lstUsers.AddItem NetUserArray(i).Fullname
            lstUsers.ItemData(lstUsers.NewIndex) = i
        End If
    Next i
    Exit Sub
err:
    DebugLog "ERR - frmNetMessage - ListOnlinePeople = " & err.Description & " - " & err.Number
End Sub

Private Sub LoadDataFile()
On Error GoTo err:
    Dim Index As Integer
    Dim strFileContents As String
    Dim strData1 As String
    Dim strData2 As String
    Dim strGroup As String
    Dim howFar As Long
    Dim blnUserRead As Boolean

    blnUserRead = True
    cboTemplateMessages.Clear
    cboTemplateMessages.AddItem ""
    ReDim NetUserArray(100)
    Open App.Path & "\ChatTool-Data.txt" For Input As #1   ' Open file for input.
    Do While Not EOF(1)   ' Loop until end of file.
        Line Input #1, strFileContents
        howFar = 1
       
        If blnUserRead Then
            strData1 = GetNextField(howFar, strFileContents)
            strData2 = GetNextField(howFar, strFileContents)
        Else
            strData1 = GetNextField(howFar, strFileContents)
        End If
       
        Select Case strData1
        Case "[userlist]"
            Index = 0
        Case "[templatemessages]"
            blnUserRead = False
            intNetUserArrayCount = Index + 1
            Index = 0
        Case "[group]"
            strGroup = strData2
            cboGroup.AddItem strGroup
        Case Else
            If blnUserRead Then
                If Trim(strData1) <> "" Then
                    If Index >= UBound(NetUserArray()) Then
                        ReDim Preserve NetUserArray(Index + 50)
                    End If
                    NetUserArray(Index).Username = strData1
                    NetUserArray(Index).Fullname = strData2
                    NetUserArray(Index).Group = strGroup
                    NetUserArray(Index).Selected = False
                    NetUserArray(Index).Online = False
                    Index = Index + 1
                End If
            Else
                cboTemplateMessages.AddItem strData1
                Index = Index + 1
            End If
        End Select
    Loop
   
    Close #1
    Exit Sub
err:
    strTmpText = GetText(1209) 'Text: The file %1 could not be loaded.\n\nError:
    strTmpText = Replace(strTmpText, "%1", App.Path & "\ChatTool-Data.txt")
    strTmpText = strTmpText & " " & err.Number & " - " & err.Description
    frmChatTool.MessageBox.MsgBox Me, strTmpText, vbExclamation
End Sub

Private Function GetNextField(howFar As Long, strFileContents As String) As String
    Dim i As Integer
    i = howFar
    howFar = InStr(howFar, strFileContents, ";")
    If howFar = 0 Then
        GetNextField = Mid(strFileContents, i, Len(strFileContents) - i + 1)
    Else
        GetNextField = Mid(strFileContents, i, howFar - i)
    End If
    howFar = howFar + 1
End Function

Project Homepage: