Tomás Bradanovic
Asesorías y Proyectos

Código Fuente

frmMain

Private WithEvents poSendMail As SendMail.clsSendMail
Option Explicit
Option Compare Text

Private Sub cmdBrowse_Click()
cmDialog.ShowOpen
txtAttach.Text = cmDialog.FileName
End Sub

Private Sub cmdReset_Click()
txtMsg.Text = ""
RetrieveSavedValues
End Sub

Private Sub cmdSend_Click()
If Mid(txtMsg.Text, 1, 27) <> "-----BEGIN PGP MESSAGE-----" Then
MsgBox "Solo puede enviar mensajes encriptados"
Exit Sub
End If
Screen.MousePointer = vbHourglass
poSendMail.SMTPHost = txtServer.Text
poSendMail.from = txtFrom.Text
poSendMail.FromDisplayName = txtFromName.Text
poSendMail.Recipient = txtTo.Text
poSendMail.RecipientDisplayName = txtToName.Text
poSendMail.ReplyToAddress = txtFrom.Text
poSendMail.Subject = txtSubject.Text
poSendMail.Message = txtMsg.Text
poSendMail.Attachment = Trim(txtAttach.Text)
poSendMail.Send
Screen.MousePointer = vbDefault
End Sub

Private Sub Command3_Click()
Dim orden As String
Close
Open "mensaje" For Random As 1 Len = 20000
men.mensaje = Trim(txtMsg.Text)
Put 1, 1, men
Close
camino = Trim(datfij.camino)
orden = "pgp -setaw +force mensaje " + Trim(clavepgp)
x = Shell(orden, 1)
Open "mensaje.asc" For Random As 1 Len = 20000
Get 1, 1, men
txtMsg = Trim(men.mensaje)
Close
End Sub

Private Sub Form_Initialize()
Set poSendMail = New clsSendMail
End Sub

Private Sub Form_Load()
Close
Open "datosfij.dat" For Random As 1
Get 1, 1, datfij
txtServer.Text = Trim(datfij.server)
txtFrom.Text = Trim(datfij.from)
txtFromName.Text = Trim(datfij.remitente)
Close
txtServer = Trim(datfij.server)
txtFrom = Trim(datfij.from)
' Dibuja colores de fondo
Dim i, Y As Integer
frmMain.Cls
frmMain.AutoRedraw = True
frmMain.DrawStyle = 6
frmMain.DrawMode = 13
frmMain.DrawWidth = 2
frmMain.ScaleMode = 3
frmMain.ScaleHeight = (256 * 2)
For i = 0 To 255
frmMain.Line (0, Y)-(frmMain.Width, Y + 2), RGB(0, 0, i), BF
Y = Y + 2
Next i
' Lee libreta de direcciones
Dim z As Integer
Open "libreta" For Random As 1
For z = 2 To 100
Get 1, z, lib
txtToName.AddItem Trim(lib.nombre)
direlec(z - 1) = Trim(lib.email)
clave(z - 1) = Trim(lib.clave)
Next z
txtTo.Text = direlec(0)
txtToName.Text = txtToName.List(0)
RetrieveSavedValues
cmDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set poSendMail = Nothing
End Sub

Private Sub Image1_Click()
Frame3.Visible = True
Label2(2).Visible = True
Label2(3).Visible = True
Label3(0).Visible = True
Label3(1).Visible = True
Image3.Visible = True
Image4.Visible = True
txtServer.Visible = False
txtFromName.Visible = False
txtFrom.Visible = False
lblServer.Visible = False
lblFrom.Visible = False
lblFromName.Visible = False
End Sub

Private Sub Image3_Click()
Frame3.Visible = False
Label2(2).Visible = False
Label2(3).Visible = False
Label3(0).Visible = False
Label3(1).Visible = False
Image3.Visible = False
Image4.Visible = False
txtServer.Visible = True
txtFromName.Visible = True
txtFrom.Visible = True
lblServer.Visible = True
lblFrom.Visible = True
lblFromName.Visible = True
Close
Open "datosfij.dat" For Random As 1
Get 1, 1, datfij
txtServer.Text = Trim(datfij.server)
txtFrom.Text = Trim(datfij.from)
txtFromName.Text = Trim(datfij.remitente)
Close
End Sub

Private Sub Image4_Click()
Load frmLibreta
frmLibreta.Show
End Sub

Private Sub Label3_Click(Index As Integer)
Load interprop
interprop.Show
End Sub

Private Sub poSendMail_SendFailed(Explanation As String)
lblStatus.Caption = ""
MsgBox ("Your attempt to send mail failed for the following reason: " & vbCrLf & Explanation)
End Sub

Private Sub poSendMail_SendSuccesful()
lblStatus.Caption = ""
MsgBox "Send Successful!"
End Sub

Private Sub CenterControlHorizontal(child As Object)
child.Left = (Me.ScaleWidth - child.Width) / 2
End Sub

Private Sub poSendMail_Status(Status As String)
lblStatus.Caption = Status
lblStatus.Refresh
End Sub

Private Sub RetrieveSavedValues()
txtServer.Text = poSendMail.SMTPHost
txtFrom.Text = poSendMail.from
txtFromName.Text = poSendMail.FromDisplayName
End Sub

Private Sub txtFrom_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Close
Open "datosfij.dat" For Random As 1
datfij.server = txtServer.Text
datfij.from = txtFrom.Text
datfij.remitente = txtFromName.Text
Put 1, 1, datfij
Close
End If
End Sub

Private Sub txtFromName_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Close
Open "datosfij.dat" For Random As 1
datfij.server = txtServer.Text
datfij.from = txtFrom.Text
datfij.remitente = txtFromName.Text
Put 1, 1, datfij
Close
End If
End Sub

Private Sub txtServer_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Close
Open "datosfij.dat" For Random As 1
datfij.server = txtServer.Text
datfij.from = txtFrom.Text
datfij.remitente = txtFromName.Text
Put 1, 1, datfij
Close
End If
End Sub

Private Sub txtToName_Click()
txtTo.Text = direlec(txtToName.ListIndex + 1)
clavepgp = clave(txtToName.ListIndex + 1)
End Sub

 

frmLibreta

Private Sub Form_Load()
Close
Open "libreta" For Random As 1
List1.Clear
For z = 2 To 100
Get 1, z, lib
List1.AddItem lib.nombre
Next z
Close
End Sub

Private Sub Image7_Click()
Unload frmLibreta
End Sub

Private Sub List1_Click()
codigoitem = (List1.ListIndex) + 2
Open "libreta" For Random As 1
Get 1, codigoitem, lib
Text1(0).Text = lib.nombre
Text1(1).Text = lib.email
Text1(2).Text = lib.clave
Close
End Sub

Private Sub Text1_GotFocus(Index As Integer)
' MarcaTodo Text1
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
Text1(0).Text = UCase(Text1(0).Text)
Text1(1).Text = LCase(Text1(1).Text)
Text1(2).Text = UCase(Text1(2).Text)
SendKeys "{TAB}", True
KeyAscii = 0 ' para evitar un 'beep' indeseado
End If
End Sub

 

Interprop

Private Sub Form_Load()
Dim e(30)
e(1) = "Nombre ejecutable: inter.exe"
e(2) = "Archivo de datos: intermov.dat"
e(3) = "Archivo de datos: item.dat"
e(4) = "Tipo de archivos de datos:"
e(5) = "ASCII plano, sin indexación"
e(6) = "La primera posición almacena"
e(7) = "la cantidad de registros."
e(8) = "Lenguaje programa:"
e(9) = "Microsoft Visual Basic 4.0"
e(10) = "(Enterprise Edition)"
e(11) = "Lenguaje generador informes:"
e(12) = "Visual Basic Aplication Edition"
e(13) = "(Excel-Word)"
e(14) = "****************************"
e(15) = " (r) Tomás Bradanovic"
e(16) = " Programación y Asesoría"
For z = 1 To 16
List1.AddItem e(z)
Next z
End Sub

Private Sub Image5_Click()
Unload interprop
Load frmMain
frmMain.Show
End Sub

Private Sub Image7_Click()
Unload interprop
End Sub

 

Module1 (Globales.mail.bas)

'********************************************
'
' Tomas Bradanovic Computación
' Codornices 1520 fonos 231211 - 253956
' Arica, Chile
'
' Aplicación de Correo Electrónico Seguro
' Clientes :
' - Poder Judicial de Arica
' - Policía de Investigaciones de Chile
'
' Ejecutable : correo seguro.exe
' Ultima modificación el 21-11-99
'
'*********************************************

Option Explicit
Type datosfijos
server As String * 20
from As String * 20
remitente As String * 30
camino As String * 30
End Type
Type libretadirecciones
nombre As String * 30
email As String * 30
clave As String * 50
End Type
Global datfij As datosfijos
Global lib As libretadirecciones
Global camino
Global archdestino
Global comando
Global clavepgp
Global codigoitem 'libreta de direcciones
Global direlec(100)
Global clave(100)
Type textomensaje
mensaje As String * 10000
End Type
Global men As textomensaje
Global x As String * 30
Sub MarcaTodo(Campo As TextBox)
Campo.SelStart = 0
Campo.SelLength = Len(Campo)
End Sub