www.pudn.com > 20063518740652.zip > READER16.FRM
VERSION 2.00
Begin Form READER
Caption = "READER"
ClientHeight = 6615
ClientLeft = 4095
ClientTop = 1140
ClientWidth = 6090
Height = 7305
Left = 4035
LinkTopic = "Form1"
ScaleHeight = 6615
ScaleWidth = 6090
Top = 510
Width = 6210
Begin OptionButton oDeleteNo
Caption = "No"
Height = 255
Left = 3720
TabIndex = 10
Top = 1320
Value = -1 'True
Width = 975
End
Begin OptionButton oDeleteYes
Caption = "Yes"
Height = 255
Left = 3000
TabIndex = 8
Top = 1320
Width = 615
End
Begin TextBox ePass
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 285
Left = 1560
PasswordChar = "*"
TabIndex = 2
Top = 960
Width = 3495
End
Begin TextBox eUser
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 285
Left = 1560
TabIndex = 3
Top = 600
Width = 3495
End
Begin TextBox eResult
Height = 615
Left = 120
MultiLine = -1 'True
TabIndex = 6
Text = "Ready."
Top = 5880
Visible = 0 'False
Width = 5655
End
Begin TextBox eMessage
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 3975
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 5
Top = 1800
Width = 5895
End
Begin TextBox eServer
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 285
Left = 1560
TabIndex = 0
Top = 240
Width = 3495
End
Begin Label lDelete
Caption = "Delete Email After Read ?"
Height = 255
Left = 360
TabIndex = 9
Top = 1340
Width = 2415
End
Begin Label lPass
Alignment = 1 'Right Justify
Caption = "Password"
Height = 375
Left = 120
TabIndex = 4
Top = 960
Width = 1215
End
Begin Label lUser
Alignment = 1 'Right Justify
Caption = "User"
Height = 255
Left = 240
TabIndex = 7
Top = 600
Width = 1095
End
Begin Label lServer
Alignment = 1 'Right Justify
Caption = "POP3 Server"
Height = 255
Left = 120
TabIndex = 1
Top = 240
Width = 1215
End
Begin Menu mReadMail
Caption = "ReadMail"
End
Begin Menu mExit
Caption = "Exit"
End
End
Option Explicit
Sub bOK_Click ()
eResult.Visible = False
eResult.Text = ""
End Sub
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
Sub mExit_Click ()
Dim Code As Integer
Code = seeClose()
End
End Sub
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 Integer
Dim NbrMsg As Integer
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 Integer
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
End Sub
Sub oDeleteNo_Click ()
oDeleteYes.Value = False
End Sub
Sub oDeleteYes_Click ()
oDeleteNo.Value = False
End Sub