Solved

How to connect through Proxy Server

Posted on 2001-07-19
9
363 Views
Last Modified: 2007-12-19
I want to develop an application in VB that needs to connect through a proxy server. It also should have the capability of providing username, password, port address etc. Something like the MSN messenger or Yahoo Messenger. Can somebody please direct me to the right stuff. Thanks in advance
0
Comment
Question by:loveneesh_bansal
9 Comments
 
LVL 4

Expert Comment

by:VincentLawlor
ID: 6297858
<Ping>
0
 
LVL 1

Expert Comment

by:Catouch
ID: 6297994
ping too...

I found this on the net (not in VB) but maybe it can help

http://www.codeproject.com/useritems/msn_messenger.asp
0
 

Expert Comment

by:jchew
ID: 6298103
<ping>

i guess this question is very popular!
0
 
LVL 1

Expert Comment

by:johnczimm
ID: 6298126
If you are willing to use a third party control, IP*Works! from /n software inc., http://www.nsoftware.com/index.asp is a great tool.  Has built in settings for proxy servers.
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 8

Expert Comment

by:DennisBorg
ID: 6298344
:ping:
0
 
LVL 55

Expert Comment

by:andyalder
ID: 6298519
Can't help on writing the application but if you install the winsock proxy client (firewall client with ISA server) then you write your application as if there was no proxy server there the modified tcp stack will deal with the proxy for you.
0
 
LVL 16

Accepted Solution

by:
Richie_Simonetti earned 70 total points
ID: 6298768
I don't know if it is complete functional. Any bug/enhancement would be really appreciated:

This class does a wrap for wininet.dll. You could use some of its functions to get your result throghout a proxy.
Optionally, it could be coverted to a bas module instead.
Please, use at your own risk and send feedback!


VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CFTP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' Constantes:
Private Const MAX_PATH = 260
'************

' Tipos:
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
' ****************************

' Variables
Private m_InetConnect As Long
Private m_InetSession As Long
' ***************************
' Enum
#If VBA = 0 Then
Public Enum enumAccessType
    ACCESSDEFAULT = 0
    ACCESSDIRECT = 1
    ACCESSPROXY = 3
End Enum

Public Enum enumService
    sFTP = 1
    sGOPHER = 2
    sHTTP = 3
End Enum
Public Enum enumTransferType
    ttASCII = 1
    ttBINARY = 2
End Enum
Public Enum enumSITE
    SITELOCAL = 0
    SITEREMOTE = 1
End Enum
#Else
    'enum AccessType replacing constant
    Const ACCESSDEFAULT = 0
    Const ACCESSDIRECT = 1
    Const ACCESSPROXY = 3
    'enum Service replacing constant
    Const sFTP = 1
    Const sGOPHER = 2
    constsHTTP = 3
    'enum TransferType replacing constant
    Const ttASCCI = 1
    Const ttBINARY = 2
    'enum SITE replacing constant
    Const SITELOCAL = 0
    Const SITEREMOTE = 1
#End If
' ********

' API: Conexi?n/desconexi?n
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
    ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
    (ByVal hInternetSession As Long, ByVal sServerName As String, _
    ByVal nServerPort As Integer, ByVal sUsername As String, _
    ByVal sPassword As String, ByVal lService As Long, _
    ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
' **************************

' API: Manage Files
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
    (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
    ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, _
    ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Boolean
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
    (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
    ByVal lpszRemoteFile As String, ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" _
    (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, _
    ByVal dwContent As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
'**********
' Manage directories
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Long
Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' *********************
' Resolving Local host...
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Const IP_SUCCESS As Long = 0
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1

Private Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To MAX_WSADescription) As Byte
   szSystemStatus(0 To MAX_WSASYSStatus) As Byte
   wMaxSockets As Long
   wMaxUDPDG As Long
   dwVendorInfo As Long
End Type

Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
  (ByVal hostname As String) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (xDest As Any, _
   xSource As Any, _
   ByVal nbytes As Long)

Private Declare Function lstrlenA Lib "kernel32" _
  (lpString As Any) As Long

Private Declare Function WSAStartup Lib "WSOCK32.DLL" _
   (ByVal wVersionRequired As Long, _
    lpWSADATA As WSADATA) As Long
   
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
'*************

' Internet connection
Private ConnState As Long
Private bolAutoConnect As Boolean
Private Const INTERNET_AUTODIAL_FORCE_ONLINE As Long = 1 'Forces an online Internet connection.
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED As Long = 2 'Forces an unattended Internet dial-up.

Private Declare Function InternetGetConnectedState Lib "wininet" (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
Private Declare Function InternetAutodial Lib "wininet" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Boolean
Private Declare Function InternetAutodialHangup Lib "wininet" (ByVal dwReserved As Long) As Boolean

Public Function IsInetConnected() As Boolean
' check for an active connection
' to Internet.
With Screen
    .MousePointer = vbHourglass
    Dim flags As Long
    IsInetConnected = InternetGetConnectedState(flags, 0)
    .MousePointer = vbDefault
End With
End Function


Public Function FTPCreateFolder(strFolderName As String) As Boolean
With Screen
    .MousePointer = vbHourglass
    FTPCreateFolder = FtpCreateDirectory(m_InetConnect, strFolderName)
    .MousePointer = vbDefault
End With
End Function


Public Function FTPDeleteFolder(strFolderName As String) As Boolean
With Screen
    .MousePointer = vbHourglass
    FTPDeleteFolder = FtpRemoveDirectory(m_InetConnect, strFolderName)
    .MousePointer = vbDefault
End With
End Function


'******************************
Public Function FTPGetCurrDir() As String
Attribute FTPGetCurrDir.VB_Description = "Devuelve el nombre del directorio actual en el servidor FTP."
With Screen
    .MousePointer = vbHourglass
    If m_InetConnect <> 0 Then
        Dim sRemotePath As String
   
        sRemotePath = String$(MAX_PATH, 32)
       
        FtpGetCurrentDirectory m_InetConnect, sRemotePath, MAX_PATH
        sRemotePath = Trim$(sRemotePath)
       
        FTPGetCurrDir = Left$(sRemotePath, Len(sRemotePath) - 1)
    End If
    .MousePointer = vbNormal
End With
End Function


Public Function FTPOpenSession(ByVal lAccessType As enumAccessType, _
                   Optional sProxyName As String = "Local Machine", _
                   Optional sBypassedIPs As String = vbNullString) As Boolean
Attribute FTPOpenSession.VB_Description = "Abre una sesi?n FTP. Para completar la conexi?n utilice el m?todo FTPConnect."
'lAccessType:
'AccessDefault = 0
'AccessDirect = 1
'AccessProxy = 3
With Screen
    .MousePointer = vbHourglass
    FTPOpenSession = False  ' assumes error by default

'If EstablishInternetConn = False Then
'    Screen.MousePointer = vbDefault
'    FTPOpenSession = False
'    Exit Function
'End If

Select Case lAccessType
Case 1, 0
    m_InetSession = InternetOpen("FILE TRANSFER FTP Server", _
                                  lAccessType, _
                                  vbNullString, _
                                  vbNullString, _
                                  0)
Case 3
    If sProxyName = "Local Machine" Or sProxyName = vbNullString Then
        If SocketsInitialize() Then
            'pass the local host address to the function
            Dim sHostName As String * 255
                Dim ret As Long
                   
            ret = GetComputerName(sHostName, 255)
            If ret <> 0 Then
                sHostName = Left$(sHostName, _
                                  InStr(1, sHostName, Chr$(0), vbTextCompare) - 1)
                m_InetSession = InternetOpen("FILE TRANSFER FTP Server", _
                                              lAccessType, _
                                               GetIPFromHostName(sHostName), _
                                               sBypassedIPs, 0)
            End If
        End If
    Else
        m_InetSession = InternetOpen("FILE TRANSFER FTP Server", _
                                      lAccessType, _
                                      sProxyName, _
                                      sBypassedIPs, _
                                      0)
    End If
End Select
FTPOpenSession = m_InetSession
.MousePointer = vbNormal
End With
End Function

Public Function FTPSetCurrDir(sDir As String) As Boolean
Attribute FTPSetCurrDir.VB_Description = "Establece el directorio actual del servidor FTP de acuerdo al par?metro sDir."
With Screen
    .MousePointer = vbHourglass
    FTPSetCurrDir = False  ' assumes error by default
    FTPSetCurrDir = FtpSetCurrentDirectory(m_InetConnect, "pub")
    .MousePointer = vbNormal
End With
End Function

' **********************
Private Function SocketsInitialize() As Boolean

   Dim WSAD As WSADATA
   Dim success As Long
   
   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
   
End Function


Private Sub SocketsCleanup()
   
   If WSACleanup() <> 0 Then
       MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
   End If
   
End Sub


Private Function GetIPFromHostName(ByVal sHostName As String) As String

  'converts a host name to an IP address.

   Dim nbytes As Long
   Dim ptrHosent As Long
   Dim ptrName As Long
   Dim ptrAddress As Long
   Dim ptrIPAddress As Long
   Dim sAddress As String
   
   sAddress = Space$(4)

   ptrHosent = gethostbyname(sHostName & vbNullChar)

   If ptrHosent <> 0 Then

     'assign pointer addresses and offset
     
     'The Address is offset 12 bytes from the start of
     'the HOSENT structure. Note: Here we are retrieving
     'only the first address returned. To return more than
     'one, define sAddress as a string array and loop through
     'the 4-byte ptrIPAddress members returned. The last
     'item is a terminating null. All addresses are returned
     'in network byte order.
      ptrAddress = ptrHosent + 12
     
     'get the IP address
      CopyMemory ptrAddress, ByVal ptrAddress, 4
      CopyMemory ptrIPAddress, ByVal ptrAddress, 4
      CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4

      GetIPFromHostName = IPToText(sAddress)

   End If
   
End Function


Private Function IPToText(ByVal IPAddress As String) As String

   IPToText = CStr(Asc(IPAddress)) & "." & _
              CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
              CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
              CStr(Asc(Mid$(IPAddress, 4, 1)))
             
End Function

Public Function EnumFilesFTP(ByRef intFilesFound As Integer, Optional sExtension As String = "*.*") As String()
Attribute EnumFilesFTP.VB_Description = "Devuleve un array de strings indexado de 1 a n, conteniendo el nombre de los archivos encontrados en el servidor."

With Screen
    .MousePointer = vbHourglass
    Dim arrFiles() As String, idx As Long
    Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
       
    'create a buffer
    pData.cFileName = String(MAX_PATH, 0)
       
    'find the first file
    hFind = FtpFindFirstFile(m_InetConnect, sExtension, pData, 0, 0)
       
    'if there's no file, then exit sub
    If hFind = 0 Then Exit Function
   
    'show the filename
    Dim fname As String
    fname = Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
    If fname <> "." Then
        idx = idx + 1
        ReDim arrFiles(idx)
        arrFiles(idx) = fname
    End If
   
    Do
        'create a buffer
        pData.cFileName = String(MAX_PATH, 0)
        'find the next file
        lRet = InternetFindNextFile(hFind, pData)
        'if there's no next file, exit do
        If lRet = 0 Then Exit Do
        'show the filename
        fname = Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
        If fname <> ".." Then
           idx = idx + 1
           ReDim Preserve arrFiles(idx)
           arrFiles(idx) = fname
        End If
    Loop
   
    'close the search handle
    InternetCloseHandle hFind
   
    'returns names of files found and quantity
    intFilesFound = idx
    EnumFilesFTP = arrFiles
    .MousePointer = vbNormal
End With
End Function

' *************
Public Function FTPConnect(sSvrFTP As String, _
                           SUser As String, _
                           sPwd As String, _
                           sService As enumService, _
                           Optional iFTPSvrPort As Integer = 21) _
                           As Boolean
Attribute FTPConnect.VB_Description = "Establece la conexi?n con el servidor FTP."
With Screen
    .MousePointer = vbHourglass
    If m_InetSession <> 0 Then
        m_InetConnect = InternetConnect(m_InetSession, sSvrFTP, iFTPSvrPort, SUser, sPwd, sService, 0, 0)
    End If
    FTPConnect = (m_InetConnect <> 0)
    .MousePointer = vbNormal
End With
End Function

Public Sub FTPCloseSession()
Attribute FTPCloseSession.VB_Description = "Desconecta del servidor FTP y cierra la sesi?n iniciada con FTPOpen. Para volver a conectar, deben usarse los metodos FTPOpen y FTPConnect."
With Screen
    .MousePointer = vbHourglass
    InternetCloseHandle m_InetConnect
    InternetCloseHandle m_InetSession
    If bolAutoConnect Then InternetAutodialHangup 0
    .MousePointer = vbNormal
End With
End Sub

Public Function FTPGet(sRemoteFile As String, sLocalFile As String, Optional TransferType As enumTransferType = ttBINARY) As Boolean
Attribute FTPGet.VB_Description = "Obtiene una copia del archivo ubicadi?o en el servidor FTP (sRemoteFile) y lo guarda localmente en el path y nombre especificado en el par?metro sLocalFile. Si se omite el par?metro TransferType (ASCII o Binary), la transferencia se realizara en forma bi"
With Screen
    .MousePointer = vbHourglass
    FTPGet = False  ' assumes error by default
    FTPGet = FtpGetFile(m_InetConnect, sRemoteFile, sLocalFile, 0, 0, TransferType, 0)
    .MousePointer = vbNormal
End With
End Function

Public Function FTPPut(sLocalFile As String, sRemoteFile As String, Optional TransferType As enumTransferType = ttBINARY) As Boolean
Attribute FTPPut.VB_Description = "Envia una copia del archivo local al servidor FTP. Si el par?metro TransferType se omite, la transferencia se realizar? en formato Binario."
Screen.MousePointer = vbHourglass
FTPPut = False  ' assumes error by default
FTPPut = FtpPutFile(m_InetConnect, sLocalFile, sRemoteFile, TransferType, 0)
Screen.MousePointer = vbNormal
End Function

Public Function FileDelete(ByVal sFileName As String, ByVal sSite As enumSITE) As Boolean
Attribute FileDelete.VB_Description = "Borra el archivo especificado en el argumento sFileName. Debe establecer si el archivo es local o remoto con el par?metro sSite."
On Error GoTo errTrap
With Screen
    .MousePointer = vbHourglass
    FileDelete = False  ' assumes error by default
    Select Case sSite
    Case 0
        Kill sFileName
        If Err.Number = 0 Then FileDelete = True
    Case 1
        FileDelete = FtpDeleteFile(m_InetConnect, sFileName)
    End Select
    .MousePointer = vbNormal
End With
Exit Function
errTrap:
Err.Clear
FileDelete = False
Screen.MousePointer = vbNormal
End Function
Public Function FileRename(sOldName As String, sNewName As String, ByVal sSite As enumSITE) As Boolean
Attribute FileRename.VB_Description = "Renombra el archivo especificado en el pr?metro sOldName con el nombre de archivo especificado en el par?metro sNewName. Esttablezca el par?metro sSite para determinar si el archivo es local o remoto."
On Error GoTo errTrap
With Screen
    .MousePointer = vbHourglass
   
    FileRename = False  ' assumes error by default
    Select Case sSite
    Case 0
        Name sOldName As sNewName
        If Err.Number = 0 Then _
        FileRename = True
    Case 1
        FileRename = FtpRenameFile(m_InetConnect, sOldName, sNewName)
    End Select
   
    .MousePointer = vbNormal
End With
Exit Function
errTrap:
Err.Clear
FileRename = False
Screen.MousePointer = vbNormal
End Function

Public Function EnumFilesLocal(sPath As String, _
                                lFileType As VbFileAttribute, _
                                ByRef intFilesFound As Integer, _
                                Optional sExtension As String = "*.*") As String()
Attribute EnumFilesLocal.VB_Description = "Devuleve un array de strings indexado de 1 a n, conteniendo el nombre de los archivos encontrados en el disco local."
Screen.MousePointer = vbHourglass
Dim sFileName() As String
Dim sFullName As String
Dim sPathTmp As String, sExtensionTmp As String
Dim idx As Integer, ret As String

' cheking backslash...
If Right$(sPath, 1) <> "\" Then
    sPathTmp = sPath & "\"
End If
If Left$(sExtension, 1) = "\" Then
    sExtensionTmp = Mid$(sExtension, 2)
End If
' *********************

sFullName = sPathTmp & sExtensionTmp
ret = Dir$(sFullName, lFileType)

Do While ret <> ""
    If ret <> "." Or ret <> ".." Then
        ReDim Preserve sFileName(idx)
        sFileName(idx) = sPath & ret
        idx = idx + 1
    End If
    ret = Dir$()
Loop
intFilesFound = idx
EnumFilesLocal = sFileName
Screen.MousePointer = vbNormal
End Function

Public Function CreateInetConnection() As Boolean
' call default inet connection by itself.
With Screen
    .MousePointer = vbHourglass
    CreateInetConnection = InternetAutodial(INTERNET_AUTODIAL_FORCE_UNATTENDED, 0)
    .MousePointer = vbDefault
End With
End Function


0
 
LVL 49

Expert Comment

by:DanRollins
ID: 7156217
Hi loveneesh_bansal,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:

    Accept Richie_Simonetti's comment(s) as an answer.

loveneesh_bansal, if you think your question was not answered at all or if you need help, just post a new comment here; Community Support will help you.  DO NOT accept this comment as an answer.

EXPERTS: If you disagree with that recommendation, please post an explanatory comment.
==========
DanRollins -- EE database cleanup volunteer
0
 
LVL 1

Expert Comment

by:Computer101
ID: 7182408
Comment from expert accepted as answer

Computer101
E-E Moderator
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now