200pt Winsock API

Please take the code in this page (you have to download) into pure api.

http://planet-sourcecode.com/xq/ASP/txtCodeId.11609/lngWId.1/qx/vb/scripts/ShowCode.htm
By that I mean that I dont want any OCX's. No forms. I want just pure timer and winsock API. I also expect it to be optimizied.

When you finish, [modder changed request] please zip the SOURCE (no binarys please) and post it on a public web page, and post a URL here, or post the complete source in this thread [end of change].

I will test all responses and give the points to the one with the best proformence and size. Please remember, I am NOT intending to use this as an activeX DLL, I will take the class and put it into an existing project.
thevbmanAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

modderCommented:
thevbman,

Please don't ask experts to post solutions outside this forum. Experts-Exchange is a knowledge sharing community so all suggestions should be available for all to read. Apart from that comment, I wish you good luck and I hope you'll find a solution soon.

The link you posted appears to be broken, though?

Regards

modder
Community Support
0
wsh2Commented:
The link above.. is no good.. <sigh>
0
thevbmanAuthor Commented:
sorry the link is http://www.planet-source-code.com/xq/ASP/txtCodeId.11609/lngWId.1/qx/vb/scripts/ShowCode.htm
also, I would be happy to let people post the code here, I just thought if you code for a whole poject it would be easier. Also, if everyone posted there source code this page would be messy, so I would have posted the code of the best answer.
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Richie_SimonettiIT OperationsCommented:
There is a class to do ftp stuff.
Hope it helps.

'*****code begins****
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 = False
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.

    Dim flags As Long
    IsInetConnected = (InternetGetConnectedState(flags, 0) <> False)

End Function


Public Function FTPCreateFolder(strFolderName As String) As Boolean
    FTPCreateFolder = False ' assumes error by default
    FTPCreateFolder = (FtpCreateDirectory(m_InetConnect, strFolderName) <> False)
End Function


Public Function FTPDeleteFolder(strFolderName As String) As Boolean
    FTPDeleteFolder = False
    FTPDeleteFolder = (FtpRemoveDirectory(m_InetConnect, strFolderName) <> False)

End Function


'******************************
Public Function FTPGetCurrDir() As String
Attribute FTPGetCurrDir.VB_Description = "Devuelve el nombre del directorio actual en el servidor FTP."
    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

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

FTPOpenSession = False  ' assumes error by default

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 <> 0)
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."
    FTPSetCurrDir = False  ' assumes error by default
    FTPSetCurrDir = (FtpSetCurrentDirectory(m_InetConnect, sDir) <> False)
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."

    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
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."
    If m_InetSession <> 0 Then
        m_InetConnect = InternetConnect(m_InetSession, sSvrFTP, iFTPSvrPort, SUser, sPwd, sService, 0, 0)
    End If
    FTPConnect = (m_InetConnect <> 0)
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."
    InternetCloseHandle m_InetConnect
    InternetCloseHandle m_InetSession
    If bolAutoConnect Then InternetAutodialHangup 0
    bolAutoConnect = False
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"
    FTPGet = False  ' assumes error by default
    FTPGet = (FtpGetFile(m_InetConnect, sRemoteFile, sLocalFile, 0, 0, TransferType, 0) <> False)
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."
FTPPut = False  ' assumes error by default
FTPPut = (FtpPutFile(m_InetConnect, sLocalFile, sRemoteFile, TransferType, 0) <> False)
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
    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) <> False)
    End Select
Exit Function
errTrap:
Err.Clear
FileDelete = False

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
    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) <> False)
    End Select
   
Exit Function
errTrap:
Err.Clear
FileRename = False

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."

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

End Function

Public Function CreateInetConnection() As Boolean
' call default inet connection by itself.
bolAutoConnect = (InternetAutodial(INTERNET_AUTODIAL_FORCE_UNATTENDED, 0) <> False)
CreateInetConnection = bolAutoConnect
End Function


0
thevbmanAuthor Commented:
Thank you, I have to look that over, could you email it to me at the address above, the browser puts in all these line breaks every where. Thanks email addr is benjdm@telocity.com. Thanks
0
thevbmanAuthor Commented:
Also this does not fit my requirements because:

I asked to use winsock, not wininet.dll
2 I asked for my project to be motified, not for a new incompatiable peice of code
0
Richie_SimonettiIT OperationsCommented:
You post an url regarding wininet, didn't you?
0
thevbmanAuthor Commented:
Winsock <> Wininet
0
Richie_SimonettiIT OperationsCommented:
OK. Good luck!
Cheers
0
Un1Commented:
A true multithread vb source code winsock control:
(Using CreateThread API when UDP, No crash in VB6)

http://www.banasoft.com/Winsock.htm
0
DanRollinsCommented:
Hi thevbman,
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:

    Save as PAQ -- No Refund.

thevbman, Please DO NOT accept this comment as an answer.
EXPERTS: Post a comment if you are certain that an expert deserves credit.  Explain why.
==========
DanRollins -- EE database cleanup volunteer
0
NetminderCommented:
Per recommendation, points NOT refunded and question closed.

Netminder
CS Moderator
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming Languages-Other

From novice to tech pro — start learning today.