Attribute VB_Name = "cmdMailModule"
'Command prompt \ Command line mailing executable by Stav Mann. ® Stavmann2@gmail.com
'Open-Source, you may use as you wish.
'Visual Basic 6.0
'Usage:
'Important: You can not just run this through the Visual Basic IDE, you must compile and use the Command-Line to pass parameters !
'To use this, start your Visual Studio IDE and load the .vbp file \ emailFromCommandline.bas file
'If the mail account you wish to use to send the mail is not Gmail, make sure you change settings and credentials on the function.
'Compile to .exe
'
'Shell from vb \ from a command line using this syntax for your Gmail account (use your own credentials to test this if you want):
'<File Path> user=USERNAME pass=PASSWORD mail=Sendto@mail.com from=Sentfrom@mail.com subj=Subject body=This Is The Body of the letter
'P.S HTML tags work flawlessly here, so if you wish to make a new line of text, just type in a <BR> tag.
'Example:
'C:\cmdMail.exe user=myGmailUsername pass=myGmailPassword mail=stavmann2@gmail.com from=mail@mail.com subj=Hello This-Is A Subject body=This Is The Mail Body.<BR><BR>Good-Bye :)
Option Explicit
Private Const cmdUSER As String = "user=" 'SMTP Username
Private Const cmdPASS As String = "pass=" 'SMTP Password
Private Const cmdMAIL As String = "mail=" 'Targeted eMail address (Must have legit email address template (mail@domain.com) )
Private Const cmdFROM As String = "from=" '"Replay To" address (Must have legit email address template (mail@domain.com) )
Private Const cmdSUBJ As String = "subj=" 'eMail Subject
Private Const cmdBODY As String = "body=" 'eMail Body
Private Const cmdEND As String = "=END=" 'eMail Body
Public Sub Main()
'The idea is to simply grab the parameters, and split them to text strings, and then implement them straight to the mailing function.
'if went well, Msgbox (Mail Sent), Else Msgbox Error (written in the mailing function itself)
If mailSend(Trim(GetBetween(cmdUSER, cmdPASS)), _
Trim(GetBetween(cmdPASS, cmdMAIL)), _
Trim(GetBetween(cmdMAIL, cmdFROM)), _
GetBetween(cmdFROM, cmdSUBJ), _
GetBetween(cmdSUBJ, cmdBODY), _
GetBetween(cmdBODY, cmdEND) _
) = 0 Then Call MsgBox("Mail Sent!", vbInformation)
End Sub
Private Function mailSend(xUsername, xPassword, xMailTo, xFrom, xSubject, xMainText) As Integer
Dim msgA As Object 'declare the CDO
Set msgA = CreateObject("CDO.Message") 'set the CDO to reffer as CDO.Message (microsoft default object that can be found on almost all windows versions since vista by default)
msgA.To = xMailTo 'get targeted mail from command
msgA.Subject = xSubject 'get subject from command
msgA.HTMLBody = xMainText 'Main Text - You may use HTML tags here, for example <BR> to immitate "VBCRLF" (start new line) etc.
msgA.From = xFrom 'The from part, make sure its syntax template is a valid mail one, user@domain.com, or something.
'Notice, i simplified it, however, you may use more values depending on your needs, such as:
'.Bcc = "mail@mail.com" ' - BCC..
'.Cc = "mail@mail.com" ' - CC..
'.CreateMHTMLBody ("www.mywebsite.com/index.html) 'send an entire webpage from a site
'.CreateMHTMLBody ("c:\program files\download.htm) 'Send an entire webpage from your PC
'.AddAttachment ("c:\myfile.zip") 'Send a file from your pc (notice uploading may take a while depending on your connection)
'Gmail Username (from which mail will be sent)
msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = xUsername
'Gmail Password
msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = xPassword
'Mail Server address.
msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
'To set SMTP over the network = 2
'To set Local SMTP = 1
msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Type of Authenthication
'0 - None
'1 - Base 64 encoded (Normal)
'2 - NTLM
msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
'Outgoing Port
msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Send using SSL True\False
msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
'Update values of the SMTP configuration
msgA.Configuration.Fields.Update
'Send it.
msgA.Send
mailSend = Err.Number
If Err.Number <> 0 Then Call MsgBox("Mail delivery failed: " & Err.Description, vbExclamation)
End Function
Private Function GetBetween(strOne As String, strTwo As String) As String
'Grab parameters as a whole, and place the line of text on strBody, in addition to the END-OF-PARAMETERS Flag called cmdEnd.
Dim strBody As String
strBody = Command$ & cmdEND
'Locate each word's location within strBody, if its not found, don't continue.
Dim lngLocationOne As Long
Dim lngLocationTwo As Long
lngLocationOne = InStr(1, strBody, strOne, vbTextCompare)
If (lngLocationOne = 0) Then GoTo ErrHandle
lngLocationTwo = InStr(1, strBody, strTwo, vbTextCompare)
If (lngLocationTwo = 0) Then GoTo ErrHandle
'Grab a parameter value and return it.
GetBetween = Mid(strBody, lngLocationOne + Len(strOne), (lngLocationTwo - lngLocationOne - Len(strOne)))
Exit Function
ErrHandle:
GetBetween = vbNullString
End FunctionPrivate Sub Form_Load()
Shell ("C:\cmdMail.exe user=myGmailUsername pass=myGmailPassword mail=target-mail@mail.com from=my@mail.com subj=Hello This-Is A Subject body=This Is The Mail Body.<BR><BR>Good-Bye :)")
End SubPrivate Const JOY_RETURNBUTTONS As Long = &H80&
Private Const JOY_RETURNCENTERED As Long = &H400&
Private Const JOY_RETURNPOV As Long = &H40&
Private Const JOY_RETURNPOVCTS As Long = &H200&
Private Const JOY_RETURNR As Long = &H8&
Private Const JOY_RETURNRAWDATA As Long = &H100&
Private Const JOY_RETURNU As Long = &H10
Private Const JOY_RETURNV As Long = &H20
Private Const JOY_RETURNX As Long = &H1&
Private Const JOY_RETURNY As Long = &H2&
Private Const JOY_RETURNZ As Long = &H4&
Private Const JOY_RETURNALL As Long = (JOY_RETURNX Or JOY_RETURNY Or JOY_RETURNZ Or JOY_RETURNR Or JOY_RETURNU Or JOY_RETURNV Or JOY_RETURNPOV Or JOY_RETURNBUTTONS)
Private Type JOYINFOEX
dwSize As Long ' size of structure
dwFlags As Long ' flags to dicate what to return
dwXpos As Long ' x position
dwYpos As Long ' y position
dwZpos As Long ' z position
dwRpos As Long ' rudder/4th axis position
dwUpos As Long ' 5th axis position
dwVpos As Long ' 6th axis position
dwButtons As Long ' button states
dwButtonNumber As Long ' current button number pressed
dwPOV As Long ' point of view state
dwReserved1 As Long ' reserved for communication between winmm driver
dwReserved2 As Long ' reserved for future expansion
End Type
Private Declare Function joyGetPosEx Lib "winmm.dll" (ByVal uJoyID As Long, ByRef pji As JOYINFOEX) As Long
Dim JI As JOYINFOEX
Const JNum As Long = 0
'Set this to the number of the joystick that
'you want to read (a value between 0 and 15).
'The first joystick plugged in is number 0.
'The API for reading joysticks supports up to
'16 simultaniously plugged in joysticks.
'Change this Const to a Dim if you want to set
'it at runtime.
Private Sub Form_Load()
JI.dwSize = Len(JI)
JI.dwFlags = JOY_RETURNALL
End Sub
Private Sub Timer1_Timer()
Cls
If joyGetPosEx(JNum, JI) <> 0 Then
Print "Joystick #"; CStr(JNum); " is not plugged in, or is not working."
Else
With JI
Print "X = "; CStr(.dwXpos)
Print "Y = "; CStr(.dwYpos)
Print "Z = "; CStr(.dwZpos)
Print "R = "; CStr(.dwRpos)
Print "U = "; CStr(.dwUpos)
Print "V = "; CStr(.dwVpos)
If .dwPOV < &HFFFF& Then Print "PovAngle = "; CStr(.dwPOV / 100) Else Print "PovCentered"
Print "ButtonsPressedCount = "; CStr(.dwButtonNumber)
Print "ButtonBinaryFlags = "; CStr(.dwButtons)
Picture1.Cls
Picture1.Circle (.dwXpos / &HFFFF& * (Picture1.Width - 1), .dwYpos / &HFFFF& * (Picture1.Height - 1)), 2
End With
End If
End SubOption Explicit
Private DataPath As String
Private DataBase As String
Private AllUserPath As String
Private adoConn1 As ADODB.Connection
Private ADOConnStr1 As String
Private Const ODBC_ADD_DSN = 1 ' Add user data source
Private Const ODBC_CONFIG_DSN = 2 ' Modify user data source
Private Const ODBC_REMOVE_DSN = 3 ' Delete user data source
Private Const ODBC_ADD_SYS_DSN = 4 ' System DSN functions only work
Private Const ODBC_CONFIG_SYS_DSN = 5 ' when logged in as administrator
Private Const ODBC_REMOVE_SYS_DSN = 6
Private Const ODBC_REMOVE_DEFAULT_DSN = 7
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Function SQLConfigDataSource Lib "odbccp32.dll" (ByVal hWndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
Private Function LocalInit() As Long
' Purpose:
' Starting point for application.
' =====================================================
Dim TaskID As Long
Dim sErr As Variant
Const sProc As String = "LocalInit"
On Error GoTo LocalInitErr
DataBase = "New_DB"
AllUserPath = "C:\ProgramData\NewApp\"
DataPath = AllUserPath & "NewDB.mdb"
'Verify database exists
TaskID = TestFile(AllUserPath, "NewDB.mdb")
If Not GetDSN(DataBase, "Microsoft Access Driver (*.mdb)", DataPath, ODBC_ADD_SYS_DSN) Then
Err.Raise 53 'File Not Found
End If
ADOConnStr1 = "DSN=" + DataBase + ";uid=;pwd=;database='tblNew';"
Set adoConn1 = CreateObject("ADODB.Connection")
adoConn1.Open ADOConnStr1
LocalInit = False
Exit Function
LocalInitErr:
sErr = Err
LocalInit = sErr
End Function
Private Function TestFile(PathName As String, FileName As String) As Boolean
Dim lngRet As Long
On Error GoTo TestFileErr
If Len(Dir(PathName & FileName)) = 0 Then
MkDir AllUserPath
lngRet = MsgBox("Database not Found!" & vbCrLf & "Copy blank one?", vbYesNo)
If lngRet = vbYes Then
FileCopy App.Path & "\NewDB.mdb.org", PathName & FileName
End If
End If
Exit Function
TestFileErr:
If Err = 75 Then Resume Next
End Function
Private Function GetDSN(sDSN As String, sDriver As String, sDBFile As String, lAction As Long) As Long
Dim sAttributes As String
Dim sDBQ As String
Dim lngRet As Long
Dim hKey As Long
Dim regValue As String
Dim valueType As Long
' query the Registry to check whether the DSN is already installed
' open the key
sDBQ = RegQuery(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" + sDSN, "DBQ")
If Left$(sDBQ, 11) = "No Such Key" Then
If Len(sDBFile) Then 'File path/name supplied
lngRet = MsgBox(sDBQ & vbCrLf & "CREATE IT?", vbYesNo)
If lngRet = vbYes Then
sDBQ = ""
Else
'Routine failed
GetDSN = False
Exit Function
End If
Else 'No file name supplied
GetDSN = False
Exit Function
End If
End If
If Len(sDBQ) Then 'DBQ found
If lAction = ODBC_ADD_SYS_DSN Or lAction = ODBC_ADD_DSN Then
'Verify file actually exists
If Len(Dir$(sDBFile)) Then
'Simply return DBQ
sDBFile = sDBQ
GetDSN = True
Exit Function
Else 'return error
GetDSN = False
Exit Function
End If
Else 'Delete it
sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar
lngRet = SQLConfigDataSource(0&, lAction, sDriver, sAttributes)
End If
Else 'Add it
' check that the file actually exists
If Len(sDBFile) > 0 And Len(Dir$(sDBFile)) Then 'create DSN
sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar
lngRet = SQLConfigDataSource(0&, lAction, sDriver, sAttributes)
Else 'Return with error
MsgBox "Database file doesn't exist!", vbOKOnly + vbCritical
GetDSN = False
Exit Function
End If
End If
If lngRet Then
GetDSN = True
Else
GetDSN = False
End If
End Function