[Tasos]

Χριστός Ανέστη σε όλoυς!

Αλέξη μου ευχαριστώ για τις ευχές σου.

Γιώργο επισυνάπτω ένα αρχείο Zip που περιέχει μια μικρή εφαρμογή (SMS Center.exe) που απλά προϋποθέτει Microsoft .Net Framework 4.6.1 για να λειτουργήσει.

Η εφαρμογή τρέχει με διπλό κλικ χωρίς εγκατάσταση και βασίζεται στον κώδικα του πρώτου μηνύματος αυτού του θέματος.

Επίσης υπάρχουν τα κατάλληλα πεδία για να καταχωρήσεις τα στοιχεία χρήστη, τηλ. αριθμό, τίτλο και μήνυμα.

Θέλω να αποσυμπιέσεις και να τρέξεις την εφαρμογή.

Αν δεις ότι λειτουργεί όπως πρέπει τότε θα φτιάξουμε κάτι αντίστοιχο στην VBA.

Ο κώδικας που περιέχεται στη φόρμα της εφαρμογής είναι ο παρακάτω:

Imports System.Net
Imports System.Text
Imports System.Web

Public Class frmMain

    Public Function SendSMS(pass_url As String)

        Dim s As HttpWebRequest
        Dim enc As UTF8Encoding
        Dim postdata As String = ""
        Dim postdatabytes As Byte()
        Dim strurl As String
        strurl = pass_url
        Dim rtnvalue As String = ""
        Try
            s = HttpWebRequest.Create(strurl)
            enc = New System.Text.UTF8Encoding()
            Dim connection_guid, api_guid As String
            connection_guid = System.Guid.NewGuid.ToString()
            api_guid = "xxx_guid"
            postdata &= "&api_guid=" & api_guid
            postdata = postdata & "&connection_guid=" & connection_guid
            postdatabytes = enc.GetBytes(postdata)
            s.Method = "POST"
            s.ContentType = "application/x-www-form-urlencoded"
            s.ContentLength = postdatabytes.Length

            Try
                Using stream = s.GetRequestStream()
                    stream.Write(postdatabytes, 0, postdatabytes.Length)
                End Using
                Dim httpWebResponse As System.Net.HttpWebResponse = s.GetResponse()

                If httpWebResponse.StatusCode = System.Net.HttpStatusCode.OK Then

                    Dim responseReader As System.IO.StreamReader =
                        New System.IO.StreamReader(httpWebResponse.GetResponseStream)
                    rtnvalue = responseReader.ReadToEnd()

                Else
                    rtnvalue = "no return"
                End If
            Catch ex As Exception
                rtnvalue = ex.Message
            End Try
        Catch ex As Exception
            rtnvalue = ex.Message
        End Try
        Return rtnvalue
    End Function

    Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles btnSendSMS.Click
        Dim usr, psw, mobnu, title, message As String
        Dim emptyTextBoxes =
            From txt In Me.Controls.OfType(Of TextBox)()
            Where txt.Text.Length = 0 And txt.Tag <> ""
            Select txt.Tag

        If emptyTextBoxes.Any Then
            MsgBox(String.Format("Συμπληρώστε τα παρακάτω πεδία για να στνεχίσετε: {0}",
                    String.Join(", ", emptyTextBoxes)) & ".", MsgBoxStyle.Exclamation, "SMS Center")
            Return
        End If
        usr = HttpUtility.UrlEncode(txtUSR.Text.Trim) ' HttpUtility.UrlEncode("email@email.com")
        psw = HttpUtility.UrlEncode(txtPass.Text.Trim) 'HttpUtility.UrlEncode("7fhd8y8erwe")
        mobnu = HttpUtility.UrlEncode(txtMobilNumbers.Text.Trim) ' HttpUtility.UrlEncode("35799999999")
        title = HttpUtility.UrlEncode(txtTitle.Text) 'HttpUtility.UrlEncode("Amlex")
        message = HttpUtility.UrlEncode(txtBody.Text.Trim) 'HttpUtility.UrlEncode("Test API")
        txtResponse.Text = SendSMS("http://api.microsms.net/sendapidirect.asp?usr=" & usr _
            & "&psw=" & psw & "&dtype=1&title=" & title & "&mobnu=" & mobnu & "&message=" & message)
    End Sub

    Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.txtUSR.Text = My.Settings.USR
        Me.txtPass.Text = My.Settings.PASS
    End Sub

    Private Sub btnSaveSettings_Click(sender As Object, e As EventArgs) Handles btnSaveSettings.Click
        My.Settings.USR = Me.txtUSR.Text
        My.Settings.PASS = Me.txtPass.Text
        My.Settings.Save()
    End Sub
End Class

Καλή συνέχεια

Τάσος