Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
Dim resp As Long
Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber

Const UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12

Private Type RASDIALPARAMS
  dwSize As Long ' 1052
  szEntryName(RAS95_MaxEntryName) As Byte
  szPhoneNumber(RAS_MaxPhoneNumber) As Byte
  szCallbackNumber(RAS_MaxCallbackNumber) As Byte
  szUserName(UNLEN) As Byte
  szPassword(PWLEN) As Byte
  szDomain(DNLEN) As Byte
End Type

Function Dial(ByVal Connection As String, ByVal domain As String, ByVal Username As String, ByVal Password As String) As Boolean
  Dim rp As RASDIALPARAMS, h As Long, resp As Long
  Dim WshShell, objEnv
  Dim strDirectory, strPBKFile
  Dim test

  Set WshShell = CreateObject("WScript.Shell")
  Set objEnv = WshShell.Environment("Process")
  
  strPBKFile = objEnv("TMP") & "\rasphone.pbk"

  rp.dwSize = Len(rp) + 6
  
  ChangeBytes Connection, rp.szEntryName
  ChangeBytes "", rp.szPhoneNumber 'Phone number stored for the connection
  ChangeBytes "*", rp.szCallbackNumber 'Callback number stored for the connection
  ChangeBytes Username, rp.szUserName
  ChangeBytes Password, rp.szPassword
  ChangeBytes "*", rp.szDomain 'Domain stored for the connection
  
  resp = RasDial(ByVal 0, strPBKFile, rp, 0, ByVal 0, h) 'AddressOf RasDialFunc
  Connectie = h
  Dial = (resp = 0)
  If resp > 0 Then
    GetError (resp)
    Form1.Command1.Caption = "Return"
  Else
    Form1.Command1.Caption = "Terminalserver"
    Form1.Label5.Caption = "De Server is succesvol verbonden." & vbNewLine & vbNewLine & "Druk op terminalserver op de RDP verbinding nogmaals te starten," _
                  & "of druk op exit om de verbinding te verbreken"
  End If

End Function

Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
  'Changes a Visual Basic unicode string to an byte array
  'Returns True if it truncates str
  Dim lenBs As Long 'length of the byte array
  Dim lenStr As Long 'length of the string
  lenBs = UBound(Bytes) - LBound(Bytes)
  lenStr = LenB(StrConv(str, vbFromUnicode))

  If lenBs > lenStr Then
    CopyMemory Bytes(0), str, lenStr
    ZeroMemory Bytes(lenStr), lenBs - lenStr
  ElseIf lenBs = lenStr Then
    CopyMemory Bytes(0), str, lenStr
  Else
    CopyMemory Bytes(0), str, lenBs 'Queda truncado
    ChangeBytes = True
  End If
End Function

'Option Explicit
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal pDst As Object, ByVal pSrc As String, ByVal ByteLen As Long)
    Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByVal Destination As Object, ByVal Length As Long)
    Dim resp As Long

    <System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential, charset:=Runtime.InteropServices.CharSet.Ansi)> _
    Public Structure RASDIALPARAMS
        Public dwSize As Long
        <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,
        sizeconst:=CInt(RASFieldSizeConstants.RAS_MaxEntryName + 1))> _
        Public szEntryName() As Byte
        <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,
        sizeconst:=CInt(RASFieldSizeConstants.RAS_MaxPhoneNumber + 1))> _
        Public szPhoneNumber() As Byte
        <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,
        sizeconst:=CInt(RASFieldSizeConstants.RAS_MaxCallbackNumber + 1))> _
        Public szCallBackNumber() As Byte
        <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,
        sizeconst:=CInt(RASFieldSizeConstants.UNLEN + 1))> _
        Public szUsername() As Byte
        <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,
        sizeconst:=CInt(RASFieldSizeConstants.PWLEN + 1))> _
        Public szPassword() As Byte
        <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,
        sizeconst:=CInt(RASFieldSizeConstants.DNLEN + 1))> _
        Public szDomain() As Byte
    End Structure

Function ConnectVPN(ByVal Connection As String, ByVal domain As String, ByVal username As String, ByVal password As String) As Boolean
        Dim rp As RASDIALPARAMS, h As Long, resp As Long
        Dim strPBKFile As String

        Dim tempPath = If(Environ$("tmp") <> "", Environ$("tmp"), Environ$("temp"))

        If My.Computer.FileSystem.FileExists(tempPath & "\rasphone.pbk") Then
            Dim objReader As New System.IO.StreamReader(tempPath & "\rasphone.pbk")
            strPBKFile = objReader.ReadToEnd

            rp.dwSize = Len(rp) + 6
            ChangeBytes(Connection, rp.szEntryName)
            ChangeBytes("", rp.szPhoneNumber)
            ChangeBytes("*", rp.szCallBackNumber)
            ChangeBytes(username, rp.szUsername)
            ChangeBytes(password, rp.szPassword)
            ChangeBytes(domain, rp.szDomain)

            resp = RasDial(0, 1, rp, 0, 0, h)

            Connection = 0

            If resp > 0 Then
                GetError(resp)
                Return False
            Else
                Return True
            End If
        Else
            Return False
        End If
    End Function

    Function ChangeBytes(ByVal str As String, ByVal Bytes() As Byte) As Boolean
        'Changes a Visual Basic unicode string to an byte array
        'Returns True if it truncates str
        Dim lenBs As Byte 'length of the byte array
        Dim lenStr As Byte 'length of the string
        MsgBox(Bytes)
        lenBs = UBound(Bytes) - LBound(Bytes)
        lenStr = LenB(System.Text.Encoding.Unicode.GetBytes(str)) '(StrConv(str, vbFromUnicode))

        'lenStr = System.Text.UnicodeEncoding.Unicode.GetBytes(str)
        If lenBs > lenStr Then
            CopyMemory(Bytes(0), str, lenStr)
            ZeroMemory(Bytes(lenStr), lenBs - lenStr)
            ChangeBytes = False
        ElseIf lenBs = lenStr Then
            CopyMemory(Bytes(0), str, lenStr)
            ChangeBytes = False
        Else
            CopyMemory(Bytes(0), str, lenBs) 'Queda truncado
            ChangeBytes = True
        End If
    End Function