Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 18-09-2014
pr0sper0 pr0sper0 is offline
Miembro
NULL
 
Registrado: sep 2014
Ubicación: Villa Clara-Cuba
Posts: 12
Poder: 0
pr0sper0 Va por buen camino
Talking ¿Quien me puede llevar este codigo de Visual Basic a Delphi?

Código Delphi [-]
Option Explicit

Const RAS95_MaxEntryName = 256


Private Type RASENTRYNAME95
    dwSize As Long
    szEntryName(RAS95_MaxEntryName) As Byte
End Type


Private Type RASDIALPARAMS
    dwSize As Long
    szEntryName As String * 257
    szPhoneNumber As String * 129
    szCallbackNumber As String * 129
    szUserName As String * 257
    szPassword As String * 257
    szDomain As String * 16
    filler As String * 16
End Type


Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" _
    (ByVal reserved As String, _
     ByVal lpszPhonebook As String, _
     lprasentryname As Any, _
     lpcb As Long, _
     lpcEntries As Long) As Long
 

Private Type RASCONN
    dwSize As Long
    hRasConn As Long
    szEntryName(0 To 256) As Byte
    szDeviceType(0 To 16) As Byte
    szDeviceName(0 To 128) As Byte
    pad As Byte
End Type


Private Declare Function RasEnumConnections Lib "rasapi32" Alias "RasEnumConnectionsA" ( _
    ByVal lprasconn As Long, _
    ByVal lpcb As Long, _
    ByVal lpcConnections As Long) As Long



Private Declare Sub Sleep Lib "kernel32.dll" (ByVal miliseg As Long)

Private Declare Sub strcpyn Lib "kernel32.dll" Alias "lstrcpynA" _
    (ByVal a As String, _
     ByVal de As String, _
     ByVal N As Long)

Private Declare Function strlen Lib "kernel32.dll" Alias "lstrlenA" _
    (ByVal texto As String) As Long

Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" _
    (ByVal handle As Long) As Integer

Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" _
    (ByVal p1 As Long, _
     ByVal p2 As Long, _
     rd As RASDIALPARAMS, _
     ByVal p4 As Long, _
     ByVal p5 As Long, _
     handle As Long) As Integer

Private Declare Sub RasGetErrorString Lib "rasapi32.dll" Alias "RasGetErrorStringA" _
    (ByVal nmumer As Long, _
     ByVal buffer As String, _
     ByVal sizebuf As Long)

Private Declare Function InternetGetConnectedState Lib "wininet.dll" ( _
    ByRef lpdwFlags As Long, _
    ByVal dwReserved As Long) As Long

Dim hDial As Long

Function Conectar(Entry As String, _
                  User As String, _
                  Pass As String) As Integer

Dim Rdp As RASDIALPARAMS
    
    Rdp.dwSize = 1052
    
    strcpyn Rdp.szEntryName, Entry + Chr$(0), 256
    strcpyn Rdp.szPhoneNumber, Chr$(0), 128
    strcpyn Rdp.szCallbackNumber, Chr$(0), 128
    strcpyn Rdp.szUserName, User + Chr$(0), 256
    strcpyn Rdp.szPassword, Pass + Chr$(0), 256
    strcpyn Rdp.szDomain, Chr$(0), 15


    Conectar = RasDial(0, 0, Rdp, 0, 0, hDial)

End Function


Function Desconectar() As Long
Dim N As Long

        N = RasHangUp(hDial)
        hDial = GetHandleConnection
        Sleep (3000)
        Desconectar = N

End Function

Function TextoError(Num As Long) As String
Dim Txt As String * 128

    Txt = Chr$(0)
    RasGetErrorString Num, Txt, 127
    TextoError = Left$(Txt, strlen(Txt))

End Function
Private Sub Command1_Click()
Dim N As Long
    
    Me.MousePointer = vbHourglass
    
    If IsOnline = False Then
        MsgBox "Ya se estaba conectado a internet", vbInformation
    Else
        N = Conectar(List1, Text1, Text2)
        If N = 0 Then
            MsgBox "Conectado a internet", vbInformation
        Else
            MsgBox TextoError(N), vbCritical
        End If
     End If
     
     Me.MousePointer = 0
     
End Sub

Private Sub Command2_Click()

Dim N As Long
    
    Me.MousePointer = vbHourglass
    
    hDial = GetHandleConnection
    
    If IsOnline = False Then
        MsgBox "No se estaba conectado a internet", vbExclamation
    Else
        N = Desconectar
        If N = 0 Then
           MsgBox "Desconectado", vbInformation
        Else
           MsgBox TextoError(N), vbCritical, "Mensaje de error"
        End If
    End If
    
    hDial = GetHandleConnection
    Me.MousePointer = 0
End Sub


Private Sub ListarConexiones()

Dim s As Long, l As Long, ln As Long, a$
ReDim r(255) As RASENTRYNAME95

    r(0).dwSize = 264
    s = 256 * r(0).dwSize
    l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
    
    For l = 0 To ln - 1
        a$ = StrConv(r(l).szEntryName(), vbUnicode)
        List1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
    Next
    
    If List1.ListCount > 0 Then
        List1.ListIndex = 0
    End If
    hDial = GetHandleConnection
End Sub

Function GetHandleConnection() As Long
    Dim conn As RASCONN
    Dim y As Long, z As Long
    Dim ret As Long
    conn.dwSize = Len(conn)
    y = conn.dwSize
    ret = RasEnumConnections(VarPtr(conn), _
                             VarPtr(y), _
                             VarPtr(z))
    
    GetHandleConnection = conn.hRasConn
    
End Function
Public Function IsOnline() As Boolean
   IsOnline = InternetGetConnectedState(0&, 0&)
End Function


Private Sub Form_Load()
Text1.Visible = False
Text2.Visible = False
    Call ListarConexiones

    Me.Caption = " Acceso RAS, " & _
                 "conectar y desconectar"
    Command1.Caption = "Conectar"
    Command2.Caption = "Desconectar"
End Sub

Última edición por pr0sper0 fecha: 18-09-2014 a las 00:35:43. Razón: Quitar los comentarios
Responder Con Cita
  #2  
Antiguo 18-09-2014
Avatar de mamcx
mamcx mamcx is offline
Moderador
 
Registrado: sep 2004
Ubicación: Medellín - Colombia
Posts: 3.911
Poder: 25
mamcx Tiene un aura espectacularmamcx Tiene un aura espectacularmamcx Tiene un aura espectacular
Seria mejor que encontraras una implementacion ya hecha en delphi, la cual buscando con "rasapi32" veo varias entradas en google.
__________________
El malabarista.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Duda Visual Basic codigo AxaCrosS Varios 4 29-01-2013 18:42:45
Delphi VS Visual Basic woody Debates 137 18-03-2008 15:54:00
Urgente Quien Me Puede Ayudar Con Este Error jhcaboverde Conexión con bases de datos 2 22-09-2007 22:59:52
Delphi .. Visual Basic Saara Varios 3 09-09-2007 19:47:49
Delphi V/s Visual Basic lavtaro Varios 13 02-05-2006 15:30:47


La franja horaria es GMT +2. Ahora son las 10:33:51.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi