-
Notifications
You must be signed in to change notification settings - Fork 16
/
modMail.bas
165 lines (120 loc) · 3.92 KB
/
modMail.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
Attribute VB_Name = "modMail"
'modMail - project StealthBot - authored 8/3/04 andy@stealthbot.net
Option Explicit
Private CurrentOpenFile As Integer
Private CurrentRecord As Long
Private MailFile As String
Public Sub AddMail(ByRef tsMsg As udtMail)
Call OpenMailFile
Put #CurrentOpenFile, CurrentRecord + 1, tsMsg
Call CloseMailFile
End Sub
Public Function GetMailCount(ByVal sUser As String) As Long
Dim mTemp As udtMail
Dim i As Long
Dim Count As Long
Call OpenMailFile
If (CurrentRecord > 0) Then
For i = 1 To CurrentRecord
Get #CurrentOpenFile, i, mTemp
If (StrComp(sUser, RTrim(mTemp.To), vbTextCompare) = 0) Then
Count = Count + 1
End If
Next i
GetMailCount = Count
Else
GetMailCount = 0
End If
Call CloseMailFile
End Function
Public Sub GetMailMessage(ByVal sUser As String, ByRef theMessage As udtMail)
Dim msgTemp As udtMail
Dim i As Long
Call OpenMailFile
If (CurrentRecord > 0) Then
For i = 1 To CurrentRecord
Get #CurrentOpenFile, i, msgTemp
If (StrComp(sUser, RTrim(msgTemp.To), vbTextCompare) = 0) Then
theMessage = msgTemp
' Trim off the buffer space from the message.
theMessage.To = Trim(theMessage.To)
theMessage.From = Trim(theMessage.From)
theMessage.Message = Trim(theMessage.Message)
With msgTemp
.To = vbNullString
End With
Put #CurrentOpenFile, i, msgTemp
Exit For
End If
Next i
Else
With theMessage
.To = vbNullString
.From = vbNullString
.Message = vbNullString
End With
End If
Call CloseMailFile
End Sub
Public Sub OpenMailFile()
On Error GoTo ERROR_HANDLER
Dim temp As udtMail
Dim f As Integer
Dim i As Long
f = FreeFile
MailFile = GetFilePath(FILE_MAILDB)
If (LenB(Dir$(MailFile)) = 0) Then
Open MailFile For Output As #f
Close #f
End If
Open MailFile For Random As #f Len = LenB(temp)
If (LOF(f) > 0) Then
i = LOF(f) \ LenB(temp)
If (LOF(f) Mod LenB(temp) <> 0) Then
i = (i + 1)
End If
Else
i = 0
End If
CurrentRecord = i
CurrentOpenFile = f
Exit Sub
ERROR_HANDLER:
Call frmChat.AddChat(vbRed, "Error: " & Err.Description & " in " & _
"OpenMailFile().")
Exit Sub
End Sub
Public Sub CloseMailFile()
Close #CurrentOpenFile
End Sub
Public Sub CleanUpMailFile()
Dim tMail() As udtMail
Dim tTemp As udtMail
Dim i As Long
Dim c As Long
Call OpenMailFile
If (CurrentRecord > 0) Then
ReDim tMail(1 To CurrentRecord)
If (LOF(CurrentOpenFile) > 0) Then
' mail in the mail file
' collect valid entries and rewrite it
For i = 1 To CurrentRecord
Get #CurrentOpenFile, i, tTemp
tMail(i) = tTemp
Next i
End If
Call CloseMailFile
' Zap the old file
Call Kill(MailFile)
' Write a new mail file
Call OpenMailFile
c = 1
For i = 1 To UBound(tMail)
If (Len(Trim(tMail(i).To)) > 0) Then
Put #CurrentOpenFile, c, tMail(i)
c = (c + 1)
End If
Next i
End If
Call CloseMailFile
End Sub