Re: INET control - sFTP

Thanks Seth. That would be great. I would love to see how you
rewrote the INET control for your project. What is the best way to
get the code? Post it to the board or email it to me directly? let
me know Seth. Thanks again for your comments.

Pete

--- In visualbasic6programming%40yahoogroups.com">visualbasic6programmingyahoogroups.com, DNPhoenix
<dnphoenix...> wrote:
&gt;
> Bad news Pete,
&gt;
> I too ran into this issue, but only with HTTPS/SSL
> and subsequently found thet the INET control does not
> support sFTP/HTTPS, especially if the SSL is using a
> self-signed certificate. To conquour this issue, I
> ended up rewriting the INET control to allow secure
&gt; connections. I can provide you with the code for the
> control, but cannot guatantee the sFTP, since my goal
>; at the time was only HTTPS issues.
>
> Seth
>;
> --- Pete Arant <petemesa...> wrote:
&gt;
> > I have been doing a bunch of research on the INET
>; > control offered by
> > VB6. Specifically, does the control offer/support
> > sFTP (secure FTP)
> > transmissions. Bottom line, I have a windows form
>; > based application
> > (fat client) that is currently modem transferring
> > .txt files to a
> > location. I need to offer a secure FTP of the same
>; > .txt files to a
> > location that will accept sFTP transmissions. Anyone
&gt; > have any
> > information or experience with this issue. Thanks.
> >
> > Pete
>; >
> >
>
>
> Seth Alexander
> Phoenix 'Xypher' Systems
> http://wave.prohosting.com/dnphoeni/
&gt; dnphoenix...
>;
>
>
>
__________________________________________________________
_______________
> Be a better Globetrotter. Get better travel answers from someone
who knows. Yahoo! Answers - Check it out.
>; http://answers.yahoo.com/dir/?link=list&amp;sid=396545469
>

•  22
  New Members

• C programming language
• Computer programming languages
• Java programming language
• Programming languages

Hey Pete,

You asked for it, here it is...

First off this code must sit on a 'User Control' named
WinInet with 2 shapes (circles), shape1 and shape2.
These shapes act like a blinking red/green status
indicator of network activity if you make the control
visible. Other than that, all you have to do is copy
and paste the code below to the control's code window.
Hope it helps!

Seth

' *#*#*#*#*#*#*#*#*#*# Basic process variables Below
*#*#*#*#*#*#*#*#*#*#*#*#*
Option Explicit

Event StateChanged(ByVal State As Integer)

Private hInternetSession As Long
Private hInternetConnect As Long
Private hHttpOpenRequest As Long
Private mAccessType As AccessConstants
Private mDocument As String
Private mHeader As String
Private mhInternet As Long
Private mProtocol As ProtocolConstants
Private mProxy As String
Private mPassword As String
Private mRemoteHost As String
Private mRemotePort As Integer
Private mRequestTimeout As Long
Private mSecure As Boolean
Private mStillExecuting As Boolean
Private mURL As String
Private mUsername As String
Private SecFlags As Long
Private Service As Long

' *#*#*#*#*#*#*#*#*#*# Constant Declarations Below
*#*#*#*#*#*#*#*#*#*#*#*#*

'Windows Sockets constants
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&amp;
'Private Const WS_VERSION_MINOR As Long =
WS_VERSION_REQD And &HFF&amp;
'Private Const MIN_SOCKETS_REQD As Long = 1
'Private Const SOCKET_ERROR As Long = -1
'Private Const ERROR_SUCCESS As Long = 0

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

' User agent constant.
Private Const scUserAgent = "PXS&quot;

' Internet access settings.
Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Private Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0
Private Const
INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY As Long
= 4
Private Const INTERNET_OPEN_TYPE_PROXY As Long = 3

Public Enum AccessConstants
icRegistry = INTERNET_OPEN_TYPE_PRECONFIG
icDirect = INTERNET_OPEN_TYPE_DIRECT
icProxy = INTERNET_OPEN_TYPE_PROXY
icDefaultNoProxy =
INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY
End Enum

Public Enum DataTypeConstants
icString
icByteArray
End Enum

Public Enum Operations
icGet
icHead
icPost
icPut
End Enum

' Number of the TCP/IP port on the server to connect
to.
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70
Private Const INTERNET_DEFAULT_HTTP_PORT = 80
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443
Private Const INTERNET_DEFAULT_SOCKS_PORT = 1080
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Private Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
Private Const INTERNET_OPTION_SEND_TIMEOUT = 5
Private Const INTERNET_OPTION_USERNAME = 28
Private Const INTERNET_OPTION_PASSWORD = 29
Private Const INTERNET_OPTION_PROXY_USERNAME = 43
Private Const INTERNET_OPTION_PROXY_PASSWORD = 44

' Type of service to access.
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3

' Protocol Constants Declaration
Public Enum ProtocolConstants
icUnknown
icDefault
icFTP
icGopher
icHTTP
icHTTPS
icSocks
End Enum

' Brings the data across the wire even if it locally
cached.
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000

' Security constants
Private Const INTERNET_OPTION_SECURITY_FLAGS = 31
Private Const SECURITY_FLAG_IGNORE_UNKNOWN_CA = &H100
Private Const INTERNET_FLAG_IGNORE_CERT_DATE_INVALID =
&H2000
Private Const INTERNET_FLAG_IGNORE_CERT_CN_INVALID =
&H1000
Private Const INTERNET_FLAG_SECURE = &H800000
Private Const INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP As
Long = &H8000
Private Const INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS
As Long = &H4000
Private Const INTERNET_FLAG_IGNORE_REVOCATION As Long
= &H80

' The possible values for the lInfoLevel parameter
include:
Private Const HTTP_QUERY_CONTENT_TYPE = 1
'Private Const HTTP_QUERY_CONTENT_TRANSFER_ENCODING =
2
Private Const HTTP_QUERY_CONTENT_LENGTH = 5
'Private Const HTTP_QUERY_DATE = 9
Private Const HTTP_QUERY_EXPIRES = 10
Private Const HTTP_QUERY_LAST_MODIFIED = 11
'Private Const HTTP_QUERY_DERIVED_FROM = 14
Private Const HTTP_QUERY_PRAGMA = 17
Private Const HTTP_QUERY_VERSION = 18
Private Const HTTP_QUERY_STATUS_CODE = 19
Private Const HTTP_QUERY_STATUS_TEXT = 20
Private Const HTTP_QUERY_RAW_HEADERS = 21
Private Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Private Const HTTP_QUERY_FORWARDED = 30
Private Const HTTP_QUERY_SERVER = 37
Private Const HTTP_QUERY_USER_AGENT = 39
Private Const HTTP_QUERY_SET_COOKIE = 43
Private Const HTTP_QUERY_REQUEST_METHOD = 45
Private Const HTTP_STATUS_DENIED = 401
Private Const HTTP_STATUS_PROXY_AUTH_REQ = 407

Private Const FORMAT_MESSAGE_FROM_HMODULE As Long =
&H800

' Add this flag to the about flags to get request
header.
Private Const HTTP_QUERY_FLAG_REQUEST_HEADERS =
&H80000000
Private Const HTTP_QUERY_FLAG_NUMBER = &H20000000

' Flags to modify the semantics of this function. Can
be a combination of these values:

' Adds the header only if it does not already exist;
otherwise, an error is returned.
Private Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000

' Adds the header if it does not exist. Used with
REPLACE.
Private Const HTTP_ADDREQ_FLAG_ADD = &H20000000

' Replaces or removes a header. If the header value is
empty and the header is found,
' it is removed. If not empty, the header value is
replaced
Private Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000

Public Enum StateConstants
icNone
icResolvingHost
icHostResolved
icConnecting
icConnected
icRequesting
icRequestSent
icReceivingResponse
icResponseReceived
icDisconnecting
icDisconnected
icError
icResponseCompleted
End Enum

' *#*#*#*#*#*#*#*#*#*# Win32 API Declarations Below
*#*#*#*#*#*#*#*#*#*#*#*#*

Private Declare Function FormatMessage Lib "kernel32"
Alias "FormatMessageA&quot; _
(ByVal dwFlags As Long, _
lpSource As Any, _
ByVal dwMessageId As Long,
_
ByVal dwLanguageId As
Long, _
ByVal lpBuffer As String,
_
ByVal nSize As Long, _
Arguments As Long) As Long
Private Declare Function GetModuleHandle Lib
&quot;kernel32&quot; Alias "GetModuleHandleA" _
(ByVal lpModuleName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32"
Alias "LoadLibraryA&quot; (ByVal _
lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32"
(ByVal hLibModule As Long) As Long

' Opens a HTTP session for a given site.
Private Declare Function InternetConnect Lib
&quot;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

' Initializes an application's use of the Win32
Internet functions
Private Declare Function InternetOpen Lib
&quot;wininet.dll" Alias "InternetOpenA&quot; _
(ByVal sAgent As String, ByVal lAccessType As Long,
ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As
Long

' Opens an HTTP request handle.
Private Declare Function HttpOpenRequest Lib
&quot;wininet.dll" Alias "HttpOpenRequestA" _
(ByVal hHttpSession As Long, ByVal sVerb As String,
ByVal sObjectName As String, ByVal sVersion As String,
_
ByVal sReferer As String, ByVal something As Long,
ByVal lFlags As Long, ByVal lContext As Long) As Long

' Sends the specified request to the HTTP server.
Private Declare Function HttpSendRequest Lib
&quot;wininet.dll" Alias "HttpSendRequestA" (ByVal _
hHttpRequest As Long, ByVal sHeaders As String, ByVal
lHeadersLength As Long, ByVal sOptional As _
String, ByVal lOptionalLength As Long) As Integer

' Queries for information about an HTTP request.
Private Declare Function HttpQueryInfo Lib
&quot;wininet.dll" Alias "HttpQueryInfoA&quot; _
(ByVal hHttpRequest As Long, ByVal lInfoLevel As Long,
ByRef sBuffer As Any, _
ByRef lBufferLength As Long, ByRef lIndex As Long) As
Integer

' Reads data from a handle opened by the
HttpOpenRequest function.
Private Declare Function InternetReadFile Lib
&quot;wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As Any, ByVal
lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer

Private Declare Function InternetSetOption Lib
&quot;wininet.dll" Alias "InternetSetOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByRef
sBuffer As Any, ByVal lBufferLength As Long) As
Integer
Private Declare Function InternetSetOptionStr Lib
&quot;wininet.dll" Alias "InternetSetOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByVal
sBuffer As String, ByVal lBufferLength As Long) As
Integer

' Closes a single Internet handle or a subtree of
Internet handles.
Private Declare Function InternetCloseHandle Lib
&quot;wininet.dll" _
(ByVal hInet As Long) As Integer

' Queries an Internet option on the specified handle
Private Declare Function InternetQueryOption Lib
&quot;wininet.dll" Alias "InternetQueryOptionA"; _
(ByVal hInternet As Long, ByVal lOption As Long, ByRef
sBuffer As Any, ByRef lBufferLength As Long) As
Integer

' Adds one or more HTTP request headers to the HTTP
request handle.
Private Declare Function HttpAddRequestHeaders Lib
&quot;wininet.dll" Alias "HttpAddRequestHeadersA&quot; _
(ByVal hHttpRequest As Long, ByVal sHeaders As String,
ByVal lHeadersLength As Long, _
ByVal lModifiers As Long) As Integer

'Return Last WinInet.Dll response received from
transfer
Private Declare Function InternetGetLastResponseInfo
Lib "wininet.dll&quot; Alias _
"InternetGetLastResponseInfoA" (ByRef lpdwError As
Long, ByVal lpszBuffer _
As String, ByRef lpdwBufferLength As Long) As
Boolean

'String Copy
Private Declare Function gethostbyname Lib
&quot;wsock32.dll" (ByVal HostName As String) As Long

'Copy Memory
Private Declare Sub CopyMemory Lib "kernel32" Alias
&quot;RtlMoveMemory"; (xDest As Any, _
xSource As Any, ByVal nbytes As Long)

'String Length
Private Declare Function lstrlenA Lib "kernel32"
(lpString As Any) As Long

'Windows Sockets Initialize
Private Declare Function WSAStartup Lib "wsock32.dll&quot;
(ByVal wVersionRequired As Long, _
lpWSAData As WSADATA) As Long

'Windows Sockets Cleanup
Private Declare Function WSACleanup Lib "wsock32.dll&quot;
() As Long

'Internet Address to ASCII
Private Declare Function inet_ntoa Lib "wsock32.dll&quot;
(ByVal addr As Long) As Long

'String Copy
Private Declare Function lstrcpyA Lib "kernel32"
(ByVal RetVal As String, ByVal Ptr As Long) As Long


' *#*#*#*#*#*#*#*#*#*# Main Control Code Below
*#*#*#*#*#*#*#*#*#*#*#*#*

' *#*#*#*#*#*#*#*#*#*# Properties
*#*#*#*#*#*#*#*#*#*#*#*#*

Public Property Let AccessType(ByVal vData As
AccessConstants)
'Get AccessType
mAccessType = vData
End Property

Public Property Get AccessType() As AccessConstants
'Return AccessType
AccessType = mAccessType
End Property

Public Property Let Document(ByVal vData As String)
'Get Document Data
mDocument = vData
End Property

Public Property Get Document() As String
'Return Document Data
Document = mDocument
End Property

Public Property Let Header(ByVal vData As String)
'Get Header Data
mHeader = vData
End Property

Public Property Get Header() As String
'Return Header Data
Header = mHeader
End Property

Public Property Get hInternet() As Long
'Return WinInet DLL handle
hInternet = mhInternet
End Property

Public Property Let Password(ByVal vData As String)
'Get Password
mPassword = vData
End Property

Public Property Get Password() As String
'Return Password
Password = mPassword
End Property

Public Property Let protocol(ByVal vData As
ProtocolConstants)
'Get Protocol
mProtocol = vData
Select Case vData
Case icUnknown
mRemotePort = INTERNET_INVALID_PORT_NUMBER
Service = INTERNET_SERVICE_HTTP
Case icDefault
mRemotePort = INTERNET_INVALID_PORT_NUMBER
Service = INTERNET_SERVICE_HTTP
Case icFTP
mRemotePort = INTERNET_DEFAULT_FTP_PORT
Service = INTERNET_SERVICE_FTP
Case icGopher
mRemotePort = INTERNET_DEFAULT_GOPHER_PORT
Service = INTERNET_SERVICE_GOPHER
Case icHTTP
mRemotePort = INTERNET_DEFAULT_HTTP_PORT
Service = INTERNET_SERVICE_HTTP
Case icHTTPS
mRemotePort = INTERNET_DEFAULT_HTTPS_PORT
Service = INTERNET_SERVICE_HTTP
SecFlags = INTERNET_FLAG_SECURE Or _
INTERNET_FLAG_IGNORE_CERT_CN_INVALID
Or _

INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
Case icSocks
mRemotePort = INTERNET_DEFAULT_SOCKS_PORT
Service = INTERNET_SERVICE_HTTP
End Select
End Property

Public Property Get protocol() As ProtocolConstants
'Return Protocol
protocol = mProtocol
End Property

Public Property Let Proxy(ByVal vData As String)
'Get Proxy Address
mProxy = vData
End Property

Public Property Get Proxy() As String
'Return Proxy Address
Proxy = mProxy
End Property

Public Property Let RemoteHost(ByVal vData As String)
'Get Remote Host Address
mRemoteHost = vData
End Property

Public Property Get RemoteHost() As String
'Return Remote Host Address
RemoteHost = mRemoteHost
End Property

Public Property Let RemotePort(ByVal vData As Integer)
'Get Remote Port Number
mRemotePort = vData
End Property

Public Property Get RemotePort() As Integer
'Return Remote Port Number
RemotePort = mRemotePort
End Property

Public Property Let RequestTimeout(ByVal vData As
Long)
'Get Request Timeout Value
mRequestTimeout = vData
End Property

Public Property Get RequestTimeout() As Long
'Return Request Timeout Value
RequestTimeout = mRequestTimeout
End Property

Public Property Get ResponseCode() As Long
'Return Response Code
If Err.LastDllError > 12000 And Err.LastDllError <
14000 Then
ResponseCode = Err.LastDllError
End If
End Property

Public Property Get ResponseCodeString() As String
'Return Response Code String
If Err.LastDllError > 12000 And Err.LastDllError <
14000 Then
ResponseCodeString =
GetWinInetErrDesc(Err.LastDllError)
End If
End Property

Public Property Get ResponseInfo() As String
'Return Response Info
ResponseInfo = GetLastResponse
End Property

Public Property Get StillExecuting() As Boolean
'Return Execution Status
StillExecuting = mStillExecuting
End Property

Public Property Let Secure(ByVal vData As Boolean)
'Get Security setting (SSL) and set base security
flags
mSecure = vData
If vData = True Then
SecFlags = INTERNET_FLAG_SECURE Or _
INTERNET_FLAG_IGNORE_CERT_CN_INVALID
Or _

INTERNET_FLAG_IGNORE_CERT_DATE_INVALID 'Or _

'INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP Or _

'INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS Or _
'INTERNET_FLAG_IGNORE_REVOCATION
Else
SecFlags = 0
End If
End Property

Public Property Get Secure() As Boolean
'Return Security setting (SSL)
Secure = mSecure
End Property

Public Property Let URL(ByVal vData As String)
'Get URL
mURL = vData
End Property

Public Property Get URL() As String
'Return URL
URL = mURL
End Property

Public Property Let Username(ByVal vData As String)
'Get Username
mUsername = vData
End Property

Public Property Get Username() As String
'Return Username
Username = mUsername
End Property

' *#*#*#*#*#*#*#*#*#*# Public Methods/Functions
*#*#*#*#*#*#*#*#*#*#*#*#*

Public Sub Cancel()

End Sub

Public Sub Execute(URL As String, Optional Operation
As Operations, Optional InputData As String, Optional
InputHeaders As String)
' Execute Operation
Dim mOperation As String
Select Case Operation
Case icGet
mOperation = "GET&quot;
Case icHead
mOperation = "HEAD"
Case icPost
mOperation = "POST"
Case icPut
mOperation = "PUT&quot;
Case Default
mOperation = "GET&quot;
End Select
End Sub

Public Function GetChunk(Size As Long, DataType As
DataTypeConstants) As Variant

End Function

Public Function GetHeader(HeaderName As String) As
String

End Function

Public Function OpenUrl(URL As String, Optional
DataType As DataTypeConstants) As Variant
'Open the URL and return it's data
'*## Resolve Host HERE $#$#
mURL = URL
ResolveHost
If Connect Then
If Request Then
If DataType = icString Then
OpenUrl = GetDocumentString
Else
OpenUrl = GetDocumentByte
End If
RaiseEvent
StateChanged(icResponseCompleted)
Else
'Request Error
'Already Trapped
GoTo DisconnectLines
End If
Else
'Connection Error
'Already Trapped
End If
DisconnectLines:
Disconnect
End Function

' *#*#*#*#*#*#*#*#*#*# PRIVATE Methods/Functions
*#*#*#*#*#*#*#*#*#*#*#*#*

Private Function CheckUrl() As String
' Ensure we have a valid URL
Dim posSlash As Long
If InStr(1, mURL, "://&quot;) <> 0 Then
mURL = Right(mURL, Len(mURL) - InStr(1, mURL, "://&quot;) -
2)
End If
If InStr(1, mURL, ":\&quot;) <> 0 Then
mURL = Right(mURL, Len(mURL) - InStr(1, mURL, ":\&quot;) -
2)
End If
posSlash = InStr(mURL, "/&quot;)
If InStr(mURL, "/&quot;) <> 0 Then
CheckUrl = Left(mURL, InStr(mURL, "/&quot;) - 1)
Else
CheckUrl = mURL
End If
End Function

Private Function Connect() As Boolean
'Establish Connection
RaiseEvent StateChanged(icConnecting)
hInternetSession = InternetOpen(scUserAgent,
mAccessType, vbNullString, vbNullString, 0)
If hInternetSession = 0 Then
RaiseEvent StateChanged(icError)
Connect = False
Else
hInternetConnect =
InternetConnect(hInternetSession, CheckUrl,
mRemotePort, _
mUsername, mPassword,
Service, 0, 0)
If hInternetConnect <= 0 Then
RaiseEvent StateChanged(icError)
Connect = False
Exit Function
End If
RaiseEvent StateChanged(icConnected)
Connect = True
End If
End Function

Private Function Disconnect() As Boolean
'Drop Handles and Internet Connection
RaiseEvent StateChanged(icDisconnecting)
InternetCloseHandle (hHttpOpenRequest)
InternetCloseHandle (hInternetSession)
InternetCloseHandle (hInternetConnect)
RaiseEvent StateChanged(icDisconnected)
End Function

Private Function GetDocumentByte() As Variant
'Grab the WebPage as Binary and Return
Dim bDoLoop As Boolean
Dim sReadBuffer() As Byte
Dim lNumberOfBytesRead As Long
Dim sBuffer As String
ReDim sReadBuffer(2048)
On Error Resume Next
bDoLoop = True
While bDoLoop
RaiseEvent StateChanged(icReceivingResponse)
Shape1.Visible = False
Shape2.Visible = True
'bDoLoop = InternetReadFile(hHttpOpenRequest,
sReadBuffer, LenB(sReadBuffer), lNumberOfBytesRead)
sBuffer = sBuffer & Left$(sReadBuffer,
lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop
= False
Shape1.Visible = True
Shape2.Visible = False
RaiseEvent StateChanged(icResponseReceived)
Wend
GetDocumentByte = sBuffer
End Function

Private Function GetDocumentString() As String
'Grab the WebPage as String and Return
Dim bDoLoop As Boolean
Dim sReadBuffer As String * 2048
Dim lNumberOfBytesRead As Long
Dim sBuffer As String
On Error Resume Next
bDoLoop = True
While bDoLoop
RaiseEvent StateChanged(icReceivingResponse)
Shape1.Visible = False
Shape2.Visible = True
bDoLoop = InternetReadFile(hHttpOpenRequest,
sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
sBuffer = sBuffer & Left$(sReadBuffer,
lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop
= False
Shape1.Visible = True
Shape2.Visible = False
RaiseEvent StateChanged(icResponseReceived)
Wend
GetDocumentString = sBuffer
mDocument = sBuffer
End Function

Private Function GetLastResponse() As String
'This function retrieves last server response.
Dim lError As Long
Dim strBuffer As String
Dim lBufferSize As Long
Dim RetVal As Long

RetVal = InternetGetLastResponseInfo(lError,
strBuffer, _
lBufferSize)
strBuffer = String(lBufferSize + 1, 0)
RetVal = InternetGetLastResponseInfo(lError,
strBuffer, _
lBufferSize)
GetLastResponse = strBuffer
End Function

Private Function GetWinInetErrDesc(dError As Long) As
String
'Returns the error description from Win32
Dim dwLength As Long
Dim strBuffer As String * 257

dwLength =
FormatMessage(FORMAT_MESSAGE_FROM_HMODULE, _
ByVal mhInternet, dError,
0&, _
ByVal strBuffer, 256&, 0&)
If dwLength > 0 Then
GetWinInetErrDesc = Left(strBuffer, dwLength -
2)
End If
End Function

Private Function GetUrlObject() As String
'Look for actual page reference for GET operation
If InStr(mURL, "/&quot;) <> 0 Then
GetUrlObject = Right(mURL, Len(mURL) -
InStr(mURL, "/&quot;) + 1)
Else
GetUrlObject = "&quot;
End If
End Function

Private Function Request() As Boolean
'Request Function for HTTP/HTTPS
Dim mMethod As String
RaiseEvent StateChanged(icRequesting)
If InStr(1, mURL, "?&quot;) Then
mMethod = "POST"
Else
mMethod = "GET&quot;
End If
hHttpOpenRequest =
HttpOpenRequest(hInternetConnect, mMethod,
GetUrlObject, "HTTP/1.0", vbNullString, 0, _
INTERNET_FLAG_RELOAD Or
INTERNET_FLAG_KEEP_CONNECTION Or SecFlags, 0)
'hHttpOpenRequest =
HttpOpenRequest(hInternetConnect, "GET&quot;, GetUrlObject,
";HTTP/1.0&quot;, vbNullString, 0, _
' INTERNET_FLAG_RELOAD Or
INTERNET_FLAG_KEEP_CONNECTION Or SecFlags, 0)
If hHttpOpenRequest = 0 Then
RaiseEvent StateChanged(icError)
Request = False
Else
Dim iRetVal As Integer
Dim sBuffer As String * 1024
Dim sOptionBuffer As String
Dim lOptionBufferLen As Long
Dim sHeader As String
Dim dwSecFlag As Long
sOptionBuffer = vbNullString
lOptionBufferLen = 0
iRetVal =
HttpAddRequestHeaders(hHttpOpenRequest, sHeader,
Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or
HTTP_ADDREQ_FLAG_ADD)
sHeader = "Connection: Keep-Alive" & vbCrLf
iRetVal =
HttpAddRequestHeaders(hHttpOpenRequest, sHeader,
Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or
HTTP_ADDREQ_FLAG_ADD)
iRetVal = InternetSetOption(hHttpOpenRequest,
INTERNET_OPTION_CONNECT_TIMEOUT, mRequestTimeout, 4)
iRetVal = InternetSetOption(hHttpOpenRequest,
INTERNET_OPTION_RECEIVE_TIMEOUT, mRequestTimeout, 4)
iRetVal = InternetSetOption(hHttpOpenRequest,
INTERNET_OPTION_SEND_TIMEOUT, mRequestTimeout, 4)
iRetVal = HttpSendRequest(hHttpOpenRequest,
vbNullString, 0, sOptionBuffer, lOptionBufferLen)
Resend:
iRetVal = HttpSendRequest(hHttpOpenRequest,
vbNullString, 0, sOptionBuffer, lOptionBufferLen)
If (iRetVal <> 1) And (Err.LastDllError =
12045) Then
dwSecFlag =
SECURITY_FLAG_IGNORE_UNKNOWN_CA
iRetVal =
InternetSetOption(hHttpOpenRequest,
INTERNET_OPTION_SECURITY_FLAGS, dwSecFlag, 4)
GoTo Resend
End If
If iRetVal Then
Dim dwStatus As Long, dwStatusSize As Long
dwStatusSize = Len(dwStatus)
HttpQueryInfo hHttpOpenRequest,
HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE,
dwStatus, dwStatusSize, 0
Select Case dwStatus
Case HTTP_STATUS_PROXY_AUTH_REQ
iRetVal =
InternetSetOptionStr(hHttpOpenRequest,
INTERNET_OPTION_PROXY_USERNAME, "IUSR_WEIHUA1&quot;,
Len("IUSR_WEIHUA1&quot;) + 1)
iRetVal =
InternetSetOptionStr(hHttpOpenRequest,
INTERNET_OPTION_PROXY_PASSWORD, "IUSR_WEIHUA1&quot;,
Len("IUSR_WEIHUA1&quot;) + 1)
GoTo Resend
Case HTTP_STATUS_DENIED
iRetVal =
InternetSetOptionStr(hHttpOpenRequest,
INTERNET_OPTION_USERNAME, "IUSR_WEIHUA1&quot;,
Len("IUSR_WEIHUA1&quot;) + 1)
iRetVal =
InternetSetOptionStr(hHttpOpenRequest,
INTERNET_OPTION_PASSWORD, "IUSR_WEIHUA1&quot;,
Len("IUSR_WEIHUA1&quot;) + 1)
GoTo Resend
End Select
Else
RaiseEvent StateChanged(icError)
Request = False
Exit Function
End If
Request = True
RaiseEvent StateChanged(icRequestSent)
End If
End Function

Private Function ResolveHost() As Boolean
'Resolve IP of Host
RaiseEvent StateChanged(icResolvingHost)
If SocketsInitialize() Then
mRemoteHost = CheckUrl
mRemoteHost = GetIPFromHostName(mRemoteHost)
SocketsCleanup
Else
RaiseEvent StateChanged(icError)
ResolveHost = False
Exit Function
End If
RaiseEvent StateChanged(icHostResolved)
ResolveHost = True
End Function

Private Sub UserControl_Initialize()
'Initialize User Control
mhInternet = GetModuleHandle(&quot;wininet.dll")
If mhInternet = 0 Then
mhInternet = LoadLibrary("wininet.dll&quot;)
End If
RaiseEvent StateChanged(icNone)
End Sub

Private Sub UserControl_Terminate()
'Clean up User Control
FreeLibrary mhInternet
End Sub

Private Function SocketsInitialize() As Boolean
' Initialize Socket
Dim WSAD As WSADATA
Dim success As Long
SocketsInitialize = WSAStartup(WS_VERSION_REQD,
WSAD) = IP_SUCCESS
End Function

Private Sub SocketsCleanup()
'Close Socket
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 'address of HOSENT structure
Dim ptrName As Long 'address of name pointer
Dim ptrAddress As Long 'address of address pointer
Dim ptrIPAddress As Long
Dim ptrIPAddress2 As Long
ptrHosent = gethostbyname(sHostName & vbNullChar)
If ptrHosent <> 0 Then
'assign pointer addresses and offset
'Null-terminated list of addresses for the host.
'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 ptrIPAddress2, ByVal ptrIPAddress, 4
GetIPFromHostName =
GetInetStrFromPtr(ptrIPAddress2)
End If
End Function

Private Function GetStrFromPtrA(ByVal lpszA As Long)
As String
'Get String From Pointer
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function

Private Function GetInetStrFromPtr(Address As Long) As
String
'Get Internet Address as String from Pointer
GetInetStrFromPtr =
GetStrFromPtrA(inet_ntoa(Address))
End Function

--- Pete Arant < petemesa%40sbcglobal.net">petemesasbcglobal.net> wrote:

> Thanks Seth. That would be great. I would love to
> see how you
> rewrote the INET control for your project. What is
> the best way to
> get the code? Post it to the board or email it to me
> directly? let
> me know Seth. Thanks again for your comments.
>
> Pete
>;
> --- In visualbasic6programming%40yahoogroups.com">visualbasic6programmingyahoogroups.com,
> DNPhoenix
> <dnphoenix...> wrote:
&gt; >
>; > Bad news Pete,
&gt; >
> > I too ran into this issue, but only with
>; HTTPS/SSL
> > and subsequently found thet the INET control does
>; not
> > support sFTP/HTTPS, especially if the SSL is using
&gt; a
> > self-signed certificate. To conquour this issue, I
> > ended up rewriting the INET control to allow
&gt; secure
&gt; > connections. I can provide you with the code for
> the
> > control, but cannot guatantee the sFTP, since my
> goal
>; > at the time was only HTTPS issues.
> >
> > Seth
>; >
> > --- Pete Arant <petemesa...> wrote:
&gt; >
> > > I have been doing a bunch of research on the
> INET
>; > > control offered by
> > > VB6. Specifically, does the control
> offer/support
> > > sFTP (secure FTP)
> > > transmissions. Bottom line, I have a windows
> form
>; > > based application
> > > (fat client) that is currently modem
&gt; transferring
> > > .txt files to a
> > > location. I need to offer a secure FTP of the
> same
>; > > .txt files to a
> > > location that will accept sFTP transmissions.
> Anyone
&gt; > > have any
> > > information or experience with this issue.
&gt; Thanks.
> > >
> > > Pete
>; > >
> > >
> >
> >
> > Seth Alexander
> > Phoenix 'Xypher' Systems
> > http://wave.prohosting.com/dnphoeni/
&gt; > dnphoenix...
>; >
> >
> >
> >
>
__________________________________________________________
> _______________
&gt; > Be a better Globetrotter. Get better travel
&gt; answers from someone
> who knows. Yahoo! Answers - Check it out.
>; >
>;
http://answers.yahoo.com/dir/?link=list&amp;sid=396545469
> >
>;
>
>

Seth Alexander
Phoenix 'Xypher' Systems
http://wave.prohosting.com/dnphoeni/
dnphoenix%40yahoo.com">dnphoenixyahoo.com

__________________________________________________________
Fussy? Opinionated? Impossible to please? Perfect. Join Yahoo!'s user panel and lay it on us. http://surveylink.yahoo.com/gmrs/yahoo_panel_invite.asp?a=7

•  15
  New Members

• C programming language
• Computer programming languages
• Java programming language
• Programming languages