Solved

200pt Winsock API

Posted on 2001-08-16
12
415 Views
Last Modified: 2013-11-13
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.
0
Comment
Question by:thevbman
12 Comments
 
LVL 3

Expert Comment

by:modder
ID: 6393601
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
 
LVL 14

Expert Comment

by:wsh2
ID: 6393906
The link above.. is no good.. <sigh>
0
 

Author Comment

by:thevbman
ID: 6393962
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
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6398978
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
 

Author Comment

by:thevbman
ID: 6399089
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
 

Author Comment

by:thevbman
ID: 6399191
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6399750
You post an url regarding wininet, didn't you?
0
 

Author Comment

by:thevbman
ID: 6400508
Winsock <> Wininet
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6402112
OK. Good luck!
Cheers
0
 
LVL 1

Expert Comment

by:Un1
ID: 6548774
A true multithread vb source code winsock control:
(Using CreateThread API when UDP, No crash in VB6)

http://www.banasoft.com/Winsock.htm
0
 
LVL 49

Expert Comment

by:DanRollins
ID: 7202334
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
 
LVL 5

Accepted Solution

by:
Netminder earned 0 total points
ID: 7216020
Per recommendation, points NOT refunded and question closed.

Netminder
CS Moderator
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Go is an acronym of golang, is a programming language developed Google in 2007. Go is a new language that is mostly in the C family, with significant input from Pascal/Modula/Oberon family. Hence Go arisen as low-level language with fast compilation…
When we want to run, execute or repeat a statement multiple times, a loop is necessary. This article covers the two types of loops in Python: the while loop and the for loop.
The viewer will learn additional member functions of the vector class. Specifically, the capacity and swap member functions will be introduced.
The viewer will be introduced to the member functions push_back and pop_back of the vector class. The video will teach the difference between the two as well as how to use each one along with its functionality.

705 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

13 Experts available now in Live!

Get 1:1 Help Now