Keskustelu: Yleinen keskustelu: VB6 sähköpostin lähetys

Sivun loppuun

Ohboy2 [13.02.2025 15:45:00]

(Mod. muutti otsikon. Vanha otsikko oli: ”vb6 to wifi”.)

Hei
Löytyykö esimerkki koodeja

Jarmo

Metabolix [13.02.2025 16:10:09]

Otsikko on ”vb6 to wifi”, siis mistä aiheesta oikeastaan haluat ohjeita?

wy5vn [13.02.2025 19:53:00]

varmaan vb6:sella wifiin yhdistämisestä tms

Ohboy2 [13.02.2025 20:52:48]

Aivan oikein
Emailin lähetys , vb6 sta ethernet kaapelillakin riittää

neosofta [15.02.2025 17:22:28]

Sähköpostin lähetyksellä/vastaanottamisella ei ole sinänsä mitään muuta tekemistä käytössä olevan verkkoyhteyden kanssa kuin se, että verkkoyhteys toimii.

Tässä koko roska kaikessa yksinkertaisuudessaan olettaen, että käyttiksenä on Windows:

Private Sub Command1_Click()

    Dim cdoMsg As Object
    Dim cdoConf As Object
    Set cdoMsg = CreateObject("CDO.Message")
    Set cdoConf = CreateObject("CDO.Configuration")
    Dim schema As String
    schema = "http://schemas.microsoft.com/cdo/configuration/"
    Set Flds =  cdoConf.Fields

    With Flds
        .Item(schema & "sendusing") = 2
        .Item(schema & "smtpserver") = "smtp.gmail.com" 'esim.
        .Item(schema & "smtpserverport") = 587
        .Item(schema & "smtpauthenticate") = 1
        .Item(schema & "smtpusessl") = 1
        .Item(schema & "sendusername") = "tilisi" 'erkki.esimerkki@gmail.com
        .Item(schema & "sendpassword") = "********" 'tilisi salasana
        .Item(schema & "smtpconnectiontimeout") = 30
        .Update
    End With

    'Dim attachment() As string '*
    'attachment() = Split(MailAttachments, ";")

    With cdoMsg

        Set .Configuration = cdoConf
        .To = TextBox1.Text ' vastaanottaja 'esim. lydia.loyhapera@luukku.com
        .From =  "tilisi"  'lähettäjä erkki.esimerkki@gmail.com
        .Subject = TextBox2.Text 'aihe
        .TextBody = TextBox3.Text 'viestin sisältö.
        .Bcc = TextBox4.Text 'kopio
        .Cc = TextBox5.Text 'piilokopio
        '.ReplyTo = TextBox6.Text 'erkki.puumerkki@gmail.com (vastaus eri osoitteeseen)
        'For i = 0 to UBound(attachment) '* tämän avulla voi purkaa ja syöttää
            'If attachment(i) <> "" Then 'mahdolliset merkkijonotaulukkoon kootut
                '.AddAttachment attachment(i) 'liitetiedostojen tiedostopolut
            'End If
        'Next i
        On Error Resume Next
        .Send
        If Err <> 0 Then
            MsgBox "Sähköpostin lähettämisessä tapahtui virhe" _
            & vbCrLf & vbCrLf & Err.Description
            Err.Clear
            On Error GoTo 0
        End If

    End With

    Set cdoMsg = nothing
    Set cdoConf = nothing
    Set Flds = nothing

End Sub

Gmail, ja nykyään käytännössä jokainen sähköpostipalvelu vaatii, että ns. kolmannen osapuolen (3rd party) email clientit ovat sallittuna asetuksissa jonka voi säätää palvelinpuljun sivustolla oman tilin tietoturva-asetuksissa.

Metabolix [15.02.2025 22:10:15]

Ohjelmointi olisi aika rankkaa, jos nettiyhteyden käyttämiseksi pitäisi koodata itse Ethernet- tai Wifi-tasolta lähtien. :D

wy5vn [15.02.2025 23:15:14]

Se olis ohjelmointia isolla O:lla

neosofta [16.02.2025 08:34:25]

Pikku lisäyksenä:
Nyt jos asustelet esim. Risen palvelutalossa koodilla tuskin on käyttöä syystä, että Cdosys -palikan käyttö on 100-varmasti estetty. 😉
Tällöin VB-ilmoittaa Set cdoMsg = CreateObject("CDO.Message") kohdalla ettei objektia voida luoda. Mikäli tällaista ilmoitusta ei ilmesty heti alussa näytölle kun koodi ajetaan niin Cdosys -palikka pelittää. Mikäli VB-ilmoittaa myöhemmin "Sähköpostin lähettämisessä tapahtui virhe" ja kaikki tiedot ovat varmasti oikein eli ilman typoja niin... aina voi tsekata onko verkkoadapteri(t) pois käytöstä.

Private Type NetworkAdapterInfo
    Dim Name As String
    Dim NetConnectionID As String
    Dim NetEnabled As Boolean
    Dim Speed As String
    Dim DeviceID As Long
    Dim Index As Long
    Dim MACAddress As Variant
    Dim AdapterType As Variant
    Dim InterfaceIndex As Variant
    Dim AdapterTypeID As Variant
End Type

Redim MyNetworkAdapters(0) As NetworkAdapterInfo

Private Sub Form_Load()
    GetDetailsFromNetworkAdapters
End Sub

Private Sub GetDetailsFromNetworkAdapters()

    Dim adapter As Object
    Dim NetworkAdapters As Object
    Dim wmi As Object

    Set wmi = GetObject("winmgmts:root\cimv2")
    Set NetworkAdapters = wmi.ExecQuery("Select * from Win32_NetworkAdapter where AdapterTypeId < 10 And NetConnectionID IS NOT NULL", , 48)

    For Each adapter In NetworkAdapters
        With adapter
           MyNetworkAdapters(Ubound(MyNetworkAdapters)).Name = .Name
           MyNetworkAdapters(Ubound(MyNetworkAdapters)).NetConnectionID = .NetConnectionID
           MyNetworkAdapters(Ubound(MyNetworkAdapters)).NetEnabled = .NetEnabled
           MyNetworkAdapters(Ubound(MyNetworkAdapters)).Speed = .Speed / 1000000 & "  Mbit/s"
           MyNetworkAdapters(Ubound(MyNetworkAdapters)).DeviceID = .DeviceID
           MyNetworkAdapters(Ubound(MyNetworkAdapters)).Index = .Index
           MyNetworkAdapters(Ubound(MyNetworkAdapters)).MACAddress = .MACAddress
           MyNetworkAdapters(Ubound(MyNetworkAdapters)).AdapterType = .AdapterType
           MyNetworkAdapters(Ubound(MyNetworkAdapters)).InterfaceIndex = .InterfaceIndex
           MyNetworkAdapters(Ubound(MyNetworkAdapters)).AdapterTypeID = .AdapterTypeID
        End With
        Redim Presrve MyNetworkAdapters(Ubound(MyNetworkAdapters) + 1)
    Next

    Set NetworkAdapter = Nothing
    Set wmi = Nothing

    ComboBox1.AddItem "Valitse Network adapteri"

    For i = Lbound(MyNetworkAdapters) To Ubound(MyNetworkAdapters)
        If MyNetworkAdapters(i).Name <> "" Then
            ComboBox1.AddItem MyNetworkAdapters(i).Name
        End If
    Next i

    If ComboBox1.ListCount > 0 Then
		ComboBox1.ListIndex = 0
    End If

  End Sub

  Private Sub ComboBox1_Change

    If ComboBox1.SelectedIndex = 0 Then Exit Sub

    Select Case CheckBox1.Value
        Case 1
            If CheckBox2.Value = 0 Then
                NetworkEnable_via_wmic MyNetworkAdapters(ComboBox1.SelectedIndex - 1).Index 'tai DeviceID
            Else
                NetworkDisable_via_wmic MyNetworkAdapters(ComboBox1.SelectedIndex - 1).Index 'tai DeviceID
            End If
        Case 0
            If CheckBox2.Value = 0 Then
                NetworkEnable_using_netsh MyNetworkAdapters(ComboBox1.SelectedIndex - 1).NetConnectionID
            Else
                NetworkDisable_using_netsh MyNetworkAdapters(ComboBox1.SelectedIndex - 1).NetConnectionID
            End If
        Case Else
    End Select

    Redim Preserve MyNetworkAdapters(0)
    GetDetailsFromNetworkAdapters

End Sub

Private Sub NetworkEnable_via_wmic(MyDeviceIndex As Long)
    CreateObject("Shell.Application").ShellExecute "cmd.exe", "/c wmic path win32_networkadapter where index=" & MyDeviceIndex & " call enable", "", "runas", 1
End Sub

Private Sub NetworkDisable_via_wmic(MyDeviceIndex As Long)
    CreateObject("Shell.Application").ShellExecute "cmd.exe", "/c wmic path win32_networkadapter where index=" & MyDeviceIndex & " call disable", "", "runas", 1
End sub

Private Sub NetworkEnable_using_netsh(MyNetConnectionID As String)
    CreateObject("Shell.Application").ShellExecute "cmd.exe", "/c netsh interface set interface name=""" & MyNetConnectionID & """ admin = enabled", "", "runas", 1
End Sub

Private Sub NetworkDisable_using_netsh(MyNetConnectionID As String)
    CreateObject("Shell.Application").ShellExecute "cmd.exe", "/c netsh interface set interface name=""" & MyNetConnectionID & """ admin = disabled", "", "runas", 1
End Sub

Heittelin aivan ulkomuistista ilman testaamista, mutta mikäli esim. Risen hoteissa, aikaa säätelyyn varmaankin riittää...😉

neosofta [16.02.2025 19:30:43]

Tässä toimiva VBScripti verkkosovittimien tsekkaamiseen. Elikäs Copy/Paskanna alla oleva koodi muistioon > tallenna nimellä > kaikki tiedostot > anna joku nimi ja laita tiedostopäätteeksi .vbs sitten vaan klikkaat kuvaketta ja ruudulle ilmestyy boksi jossa on tiedot asennetuista verkkosovittimista, ovatko käytössä jne.

Dim wmi
Dim NetworkAdapters
Dim adapter
Dim strCols
strCols = ""
Set wmi = GetObject("winmgmts:root\cimv2")
Set NetworkAdapters = wmi.ExecQuery("Select * from Win32_NetworkAdapter where AdapterTypeId < 10 And NetConnectionID IS NOT NULL", , 48)

For Each adapter In NetworkAdapters
    With adapter
        strCols = strCols & .Name & Chr(10)
        strCols = strCols & .NetConnectionID & Chr(10)
        strCols = strCols & .NetEnabled & Chr(10)
        strCols = strCols & .Speed / 1000000 & "  Mbit/s" & Chr(10)
        strCols = strCols & .DeviceID & Chr(10)
        strCols = strCols & .Index & Chr(10)
        strCols = strCols & .MACAddress & Chr(10)
        strCols = strCols & .AdapterType & Chr(10)
        strCols = strCols & .InterfaceIndex & Chr(10)
        strCols = strCols & .AdapterTypeID & Chr(10)
    End With
    strCols = strCols & Chr(13) & Chr(10)
Next

Set NetworkAdapters = Nothing
Set wmi = Nothing
WScript.Echo strCols

neosofta [17.02.2025 21:35:21]

Ompi semmonen bugi tossa ulkomuistista heiteyssä VB-koodissa, että kerryttää ComboBoxiin uudestaan samaa kamaa joka kierroksella, elikäs...

Redim Preserve MyNetworkAdapters(0)
ComboBox1.Clear 'tähän väliin niin ei kerry.
GetDetailsFromNetworkAdapters

neosofta [19.02.2025 15:48:01]

@Metabolix

Jätetään kaapelointistandardi pois niin...

Name: Realtek RTL872BE Wireless LAN 802.11n PCI-E Nic
NetConnectionID: WLAN
NetEnabled: Tosi
Speed: 102 Mbit/s
DeviceID: 0
Index: 0
MACAddress: XX:XX:XX:XX:XX:XX (en kerro 😉)
AdapterType: Ethernet 802.3
InterfaceIndex: 9
AdapterTypeID: 0

Name: Realtek(R) PCI(e) Ethernet Controller
NetConnectionID: Ethernet
NetEnabled: Epätosi
Speed: Näyttää hurjaa lukemaa
DeviceID: 2
Index: 2
MACAddress: XX:XX:XX:XX:XX:XX
AdapterType: Ethernet 802.3
InterfaceIndex: 11
AdapterTypeID: 0

Käytössä ZTE 5G MC801A (5G-modeemi/WiFi 6 reititin)

Elikäs Ethernet ei ole vain fyysinen kaapelointistandardi vaan elettäessä verkkokorttien (NIC) maailmassa myös WiFi-laitteita käytettäessä käytetään Ethernet-protokollaa (Data Link Layer 2 protokolla, lähde- & kohde-MAC-osoitteet)

Ohboy2 [25.02.2025 11:54:00]

Kiitos neosoftalle , mutta

"http://schemas.microsoft.com/cdo/configuration/"

The resource you are looking for has been removed, had its name changed, or is temporarily unavailable

Ohboy2 [27.02.2025 14:40:18]

Kokeilin muitakin kuin gmailia
sekä portti vaihtoehtoja , mutta

Siirtoyhteyden muodostaminen palvelimelle ei onnistunut

neosofta [27.02.2025 20:43:34]

Ohboy2 kirjoitti:

"http://schemas.microsoft.com/cdo/configuration/"

The resource you are looking for has been removed, had its name changed, or is temporarily unavailable

Palikka on poissa pelistä, todennäköisesti pääsy estetty GPedit (Group Policy) managerilla

Ohboy2 kirjoitti:

Kokeilin muitakin kuin gmailia
sekä portti vaihtoehtoja , mutta

Siirtoyhteyden muodostaminen palvelimelle ei onnistunut

neosofta kirjoitti:

Gmail, ja nykyään käytännössä jokainen sähköpostipalvelu vaatii, että ns. kolmannen osapuolen (3rd party) email clientit ovat sallittuna asetuksissa jonka voi säätää palvelinpuljun sivustolla oman tilin tietoturva-asetuksissa.

Elikä mikäli näitä asetuksia ei ole tehty oman esim. Gmail tilin asetuksissa: 3rd party email clients enabled, niin on aivan sama mitä porttiasetuksia kokeilet. Toisaalta taas mikäli admin on poistanut palikan pelistä niin on aivan sama mitä sallit säätelemällä sähköpostitilisi asetuksissa 😉

Meikälaisellä on kyseisen palikan pohjalta väännetty email-clientti käytössä päivittäin LibreOfficessa ja sähköpostit liitetiedostoineen lähtee menemään niin että hurahtaa ilman minkäänlaisia ongelmia.

Politiikkana on nyt tämä:
Starting in January 2025, Google Workspace accounts will no longer support less secure apps, third-party apps or devices that ask you to sign in to your Google Account using only your username and password. For exact dates, visit Google Workspace Updates. To access apps, you must use OAuth. To prepare for this change, review the details in Transition from less secure apps to OAuth.
Additional information

OAuth 2.0 alkaa rulata joka paikassa (jota CdoSys.dll ei tue), mutta meikäläinen viis siitä välittää...😉

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät

Kilpailu