www.pudn.com > 20063518740652.zip > READER32.FRM
VERSION 4.00
Begin VB.Form READER
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "READER"
ClientHeight = 6615
ClientLeft = 3750
ClientTop = 1590
ClientWidth = 6090
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 7305
Left = 3690
LinkTopic = "Form1"
ScaleHeight = 6615
ScaleWidth = 6090
Top = 960
Width = 6210
Begin VB.OptionButton oDeleteNo
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "No"
ForeColor = &H80000008&
Height = 255
Left = 3960
TabIndex = 10
Top = 1320
Value = -1 'True
Width = 975
End
Begin VB.OptionButton oDeleteYes
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Yes"
ForeColor = &H80000008&
Height = 255
Left = 3000
TabIndex = 8
Top = 1320
Width = 855
End
Begin VB.TextBox ePass
Appearance = 0 'Flat
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
Height = 285
Left = 1560
PasswordChar = "*"
TabIndex = 2
Top = 960
Width = 3495
End
Begin VB.TextBox eUser
Appearance = 0 'Flat
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
Height = 285
Left = 1560
TabIndex = 3
Top = 600
Width = 3495
End
Begin VB.TextBox eResult
Appearance = 0 'Flat
Height = 615
Left = 120
MultiLine = -1 'True
TabIndex = 6
Top = 5880
Visible = 0 'False
Width = 5895
End
Begin VB.TextBox eMessage
Appearance = 0 'Flat
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
Height = 3975
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 5
Top = 1680
Width = 5895
End
Begin VB.TextBox eServer
Appearance = 0 'Flat
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
Height = 285
Left = 1560
TabIndex = 0
Top = 240
Width = 3495
End
Begin VB.Label lDelete
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Delete Email After Read ?"
ForeColor = &H80000008&
Height = 255
Left = 360
TabIndex = 9
Top = 1340
Width = 2415
End
Begin VB.Label lPass
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Password"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 4
Top = 960
Width = 1215
End
Begin VB.Label lUser
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "User"
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 7
Top = 600
Width = 1095
End
Begin VB.Label lServer
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "POP3 Server"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 1
Top = 240
Width = 1215
End
Begin VB.Menu mReadMail
Caption = "ReadMail"
End
Begin VB.Menu mExit
Caption = "Exit"
End
End
Attribute VB_Name = "READER"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub bOK_Click()
eResult.Visible = False
eResult.Text = ""
End Sub
Private Sub bResult_Click()
eResult.Visible = False
eResult.Text = ""
End Sub
Private Sub Form_Load()
Dim Version As Integer
Dim S1, S2, S3 As String
eResult.Visible = True
Version = seeStatistics(SEE_GET_VERSION)
S1 = "SMTP/POP3 Email Engine Version "
S2 = Hex$(Version)
S3 = Mid$(S2, 1, 1) + "." + Mid$(S2, 2, 1) + "." + Mid$(S2, 3, 1)
eResult.Text = S1 + S3 + ". Ready to connect."
End Sub
Private Sub mExit_Click()
Dim Code As Integer
Code = seeClose()
End
End Sub
Private Sub mReadMail_Click()
'
' Email is saved in directory 'EmailDir'
' Attachments are saved in directory 'AttachDir'
'
Dim I As Integer
Dim N As Integer
Dim Code As Long
Dim NbrMsg As Long
Static Buffer As String * 1024
Static Temp As String * 256
Dim NL As String
Static FileName As String * 64
Static EmailDir As String * 64
Static AttachDir As String * 64
Dim BytesRead As Long
Dim AttachCount As Long
Dim NullString As String
NullString = Chr$(0)
EmailDir = "." + Chr$(0)
AttachDir = "." + Chr$(0)
NL = Chr$(13) + Chr$(10)
eMessage.Text = ""
eResult.Text = ""
'check that POP3 server name has been specifed
If Len(eServer.Text) = 0 Then
eResult.Text = Time$ + " Missing POP3 server name."
Exit Sub
End If
'check USER name
If Len(eUser.Text) = 0 Then
eResult.Text = Time$ + " Missing User name."
Exit Sub
End If
'check Password
If Len(ePass.Text) = 0 Then
eResult.Text = Time$ + " Missing Password."
Exit Sub
End If
' set up log file
Code = seeStringParam(SEE_LOG_FILE, "READER.LOG")
'connect to server
mReadMail.Enabled = False
'connect to server
eResult.Text = Time$ & " Connecting to POP3 server " & eServer.Text
Code = seePop3Connect(eServer.Text, eUser.Text, ePass.Text)
If Code < 0 Then
'error attempting to connect
Call ShowError(READER, Code, "seePop3Connect:")
Code = seeClose()
mReadMail.Enabled = True
Exit Sub
End If
' prefix attachment filenames with "1-", "2-", etc.
Code = seeIntegerParam(SEE_FILE_PREFIX, 1)
' get server IP address
Code = seeDebug(SEE_GET_SERVER_IP, Temp, 40)
eResult.Text = Time$ & " Connected to IP " & Left$(Temp, Code)
' get # messages waiting
NbrMsg = seeGetEmailCount()
If NbrMsg < 0 Then
Call ShowError(READER, Code, "seeGetEmailCount:")
Code = seeClose()
mReadMail.Enabled = True
Exit Sub
End If
eMessage.Text = Str$(NbrMsg) & " messages waiting." & NL
If NbrMsg = 0 Then
eResult.Text = Time$ & " You have no email waiting on the server."
Else
eResult.Text = Time$ & " " & Str$(NbrMsg) & " messages waiting."
' read email messages
For I = 1 To NbrMsg
' construct file name for this email message [must be terminated with NULL]
FileName = "Email" + LTrim$(Str$(I)) + ".mai" + Chr$(0)
eMessage.Text = eMessage.Text & "Saving email " & Str$(I) & " as " & RTrim(FileName) & "..."
' disable AUTO CALL [see Users Manual SEE4VB_U.TXT]
Code = seeIntegerParam(SEE_AUTO_CALL_DRIVER, 0)
' setup to read message I
Code = seeGetEmailFile(I, FileName, EmailDir, AttachDir)
' read email using seeDriver
Do
' execute next state [reading message I]
Code = seeDriver()
If Code = 0 Then
' driver is done
Exit Do
End If
If Code < 0 Then
'driver returned error
Call ShowError(READER, Code, "seeDriver:")
'reset option buttons
oDeleteYes.Value = False
oDeleteNo.Value = True
Exit Sub
End If
' driver not yet done, so report progress.
BytesRead = seeStatistics(SEE_GET_TOTAL_BYTES_READ)
eResult.Text = Str(BytesRead) + " bytes read."
Loop
'email has been read
BytesRead = seeStatistics(SEE_GET_TOTAL_BYTES_READ)
AttachCount = seeStatistics(SEE_GET_ATTACH_COUNT)
eMessage.Text = eMessage.Text & " (" & Str$(BytesRead) & " bytes;"
eMessage.Text = eMessage.Text & Str$(AttachCount) & " attachments)" & NL
' enable AUTO CALL
Code = seeIntegerParam(SEE_AUTO_CALL_DRIVER, 1&)
Next I
' delete email ?
If oDeleteYes.Value Then
' delete email in REVERSE order after all reading is done.
For I = NbrMsg To 1 Step -1
' delete this email from server
Code = seeDeleteEmail(I)
If Code >= 0 Then
eMessage.Text = eMessage.Text & "Email" & Str$(I) + " deleted from server." & NL
Else
eMessage.Text = eMessage.Text & "Error deleting from server." & NL
End If
Next I
End If
End If
Code = seeClose()
mReadMail.Enabled = True
eResult.Text = Time$ & " All email read."
End Sub
Private Sub oDeleteNo_Click()
oDeleteYes.Value = False
End Sub
Private Sub oDeleteYes_Click()
oDeleteNo.Value = False
End Sub