Programación General > Visual Basic 6.0 e inferiores
Conexion A Servidor Remoto
desarrollo:
Hola a todos tengo una inquietud, debere instalar una aplicacion en una pc k que se encuentra fuera del local donde esta mi servidor por lo k he leido se k puedo lograr la conexion con el servidor mediente el ip de este pero realmente no estoy muy segura de lo k debere hacer me podrian proporcionar informacion al respecto
Muchas gracias de Antemano.
RadicalEd:
Si eres una dura para la programacion con Api's, por medio de estas lo puedes hacer, pero sino hay un control llamado Winsock, con este puedes hacer conexiones a otros PC's.
Ojala te sirva.
Chao
desarrollo:
Podrias explicarme acerca de como hacerlo con Api's el winsock no es lo k necesito
RadicalEd:
Te recomiendo que te descargues este programa, enseña muy como manejar las api's de windows, por lo bruto yo no sabo como manejar las de conexion a PC's, pero aqui te dejo un ejemplo de la misma pagina donde descargas el programa.
--- Código: Text --- 'This project needs a TextBox'-> (Name)=Text1'-> MultiLine=True'in a formPrivate Sub Form_Load() 'KPD-Team 2000 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@Allapi.net Dim sSave As String Me.AutoRedraw = True Set Obj = Me.Text1 'Start subclassing HookForm Me 'create a new winsock session StartWinsock sSave 'show the winsock version on this form If InStr(1, sSave, Chr$(0)) > 0 Then sSave = Left$(sSave, InStr(1, sSave, Chr$(0)) - 1) Me.Print sSave 'connect to Microsoft.com lSocket = ConnectSock("www.microsoft.com", 80, 0, Me.hwnd, False)End SubPrivate Sub Form_Unload(Cancel As Integer) 'close our connection to microsoft.com closesocket lSocket 'end winsock session EndWinsock 'stop subclassing UnHookForm MeEnd Sub'in a modulePublic Const AF_INET = 2Public Const INVALID_SOCKET = -1Public Const SOCKET_ERROR = -1Public Const FD_READ = &H1&Public Const FD_WRITE = &H2&Public Const FD_CONNECT = &H10&Public Const FD_CLOSE = &H20&Public Const PF_INET = 2Public Const SOCK_STREAM = 1Public Const IPPROTO_TCP = 6Public Const GWL_WNDPROC = (-4)Public Const WINSOCKMSG = 1025Public Const WSA_DESCRIPTIONLEN = 256Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1Public Const WSA_SYS_STATUS_LEN = 128Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1Public Const INADDR_NONE = &HFFFFPublic Const SOL_SOCKET = &HFFFF&Public Const SO_LINGER = &H80&Public Const hostent_size = 16Public Const sockaddr_size = 16Type WSADataType wVersion As Integer wHighVersion As Integer szDescription As String * WSA_DescriptionSize szSystemStatus As String * WSA_SysStatusSize iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As LongEnd TypeType HostEnt h_name As Long h_aliases As Long h_addrtype As Integer h_length As Integer h_addr_list As LongEnd TypeType sockaddr sin_family As Integer sin_port As Integer sin_addr As Long sin_zero As String * 8End TypeType LingerType l_onoff As Integer l_linger As IntegerEnd TypePublic Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal Level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As LongPublic Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal Level As Long, ByVal optname As Long, optval As Any, optlen As Long) As LongPublic Declare Function WSAGetLastError Lib "wsock32.dll" () As LongDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongDeclare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Declare Function WSAIsBlocking Lib "wsock32.dll" () As LongPublic Declare Function WSACleanup Lib "wsock32.dll" () As LongPublic Declare Function Send Lib "wsock32.dll" Alias "send" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As LongPublic Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As LongPublic Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As LongPublic Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As IntegerPublic Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As IntegerPublic Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As LongPublic Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As LongPublic Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As LongPublic Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As LongPublic Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As LongPublic Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As LongPublic Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As LongPublic Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As LongPublic Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As LongPublic saZero As sockaddrPublic WSAStartedUp As Boolean, Obj As TextBoxPublic PrevProc As Long, lSocket As Long'subclassing functions'for more information about subclassing,'check out the subclassing tutorial at http://www.allapi.net/Public Sub HookForm(F As Form) PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)End SubPublic Sub UnHookForm(F As Form) If PrevProc <> 0 Then SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc PrevProc = 0 End IfEnd SubPublic Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If uMsg = WINSOCKMSG Then ProcessMessage wParam, lParam Else WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam) End IfEnd Function'our Winsock-message handlerPublic Sub ProcessMessage(ByVal lFromSocket As Long, ByVal lParam As Long) Dim X As Long, ReadBuffer(1 To 1024) As Byte, strCommand As String Select Case lParam Case FD_CONNECT 'we are connected to microsoft.com Case FD_WRITE 'we can write to our connection 'this is a part of the HTTP protocol 'for more information about this protocol, visit http://www.w3c.org/ strCommand = "GET http://www.microsoft.com/ HTTP/1.0" + vbCrLf strcomand = strCommand + "Pragma: no-cache" + vbCrLf strCommand = strCommand + "Accept: */*" + vbCrLf strCommand = strCommand + "Accept: text/html" + vbCrLf + vbCrLf 'send the data to our microsoft.com-connection SendData lFromSocket, strCommand Case FD_READ 'we have data waiting to be processed 'start reading the data Do X = recv(lFromSocket, ReadBuffer(1), 1024, 0) If X > 0 Then Obj.Text = Obj.Text + Left$(StrConv(ReadBuffer, vbUnicode), X) End If If X <> 1024 Then Exit Do Loop Case FD_CLOSE 'the connection with microsoft.com is closed End SelectEnd Sub'the following functions are standard WinSock functions'from the wsksock.bas-filePublic Function StartWinsock(sDescription As String) As Boolean Dim StartupData As WSADataType If Not WSAStartedUp Then If Not WSAStartup(&H101, StartupData) Then WSAStartedUp = True sDescription = StartupData.szDescription Else WSAStartedUp = False End If End If StartWinsock = WSAStartedUpEnd FunctionSub EndWinsock() Dim Ret& If WSAIsBlocking() Then Ret = WSACancelBlockingCall() End If Ret = WSACleanup() WSAStartedUp = FalseEnd SubPublic Function SendData(ByVal s&, vMessage As Variant) As Long Dim TheMsg() As Byte, sTemp$ TheMsg = "" Select Case VarType(vMessage) Case 8209 'byte array sTemp = vMessage TheMsg = sTemp Case 8 'string, if we recieve a string, its assumed we are linemode sTemp = StrConv(vMessage, vbFromUnicode) Case Else sTemp = CStr(vMessage) sTemp = StrConv(vMessage, vbFromUnicode) End Select TheMsg = sTemp If UBound(TheMsg) > -1 Then SendData = Send(s, TheMsg(0), (UBound(TheMsg) - LBound(TheMsg) + 1), 0) End IfEnd FunctionFunction ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal HWndToMsg&, ByVal Async%) As Long Dim s&, SelectOps&, Dummy& Dim sockin As sockaddr SockReadBuffer$ = "" sockin = saZero sockin.sin_family = AF_INET sockin.sin_port = htons(Port) If sockin.sin_port = INVALID_SOCKET Then ConnectSock = INVALID_SOCKET Exit Function End If sockin.sin_addr = GetHostByNameAlias(Host$) If sockin.sin_addr = INADDR_NONE Then ConnectSock = INVALID_SOCKET Exit Function End If retIpPort$ = getascip$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port) s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP) If s < 0 Then ConnectSock = INVALID_SOCKET Exit Function End If If SetSockLinger(s, 1, 0) = SOCKET_ERROR Then If s > 0 Then Dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If If Not Async Then If Connect(s, sockin, sockaddr_size) <> 0 Then If s > 0 Then Dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then If s > 0 Then Dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If Else SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then If s > 0 Then Dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If If Connect(s, sockin, sockaddr_size) <> -1 Then If s > 0 Then Dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If End If ConnectSock = sEnd FunctionFunction GetHostByNameAlias(ByVal hostname$) As Long On Error Resume Next Dim phe& Dim heDestHost As HostEnt Dim addrList& Dim retIP& retIP = inet_addr(hostname) If retIP = INADDR_NONE Then phe = gethostbyname(hostname) If phe <> 0 Then MemCopy heDestHost, ByVal phe, hostent_size MemCopy addrList, ByVal heDestHost.h_addr_list, 4 MemCopy retIP, ByVal addrList, heDestHost.h_length Else retIP = INADDR_NONE End If End If GetHostByNameAlias = retIP If Err Then GetHostByNameAlias = INADDR_NONEEnd FunctionFunction getascip(ByVal inn As Long) As String On Error Resume Next Dim lpStr& Dim nStr& Dim retString$ retString = String(32, 0) lpStr = inet_ntoa(inn) If lpStr = 0 Then getascip = "255.255.255.255" Exit Function End If nStr = lstrlen(lpStr) If nStr > 32 Then nStr = 32 MemCopy ByVal retString, ByVal lpStr, nStr retString = Left(retString, nStr) getascip = retString If Err Then getascip = "255.255.255.255"End FunctionPublic Function SetSockLinger(ByVal SockNum&, ByVal OnOff%, ByVal LingerTime%) As Long Dim Linger As LingerType Linger.l_onoff = OnOff Linger.l_linger = LingerTime If setsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then Debug.Print "Error setting linger info: " & WSAGetLastError() SetSockLinger = SOCKET_ERROR Else If getsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then Debug.Print "Error getting linger info: " & WSAGetLastError() SetSockLinger = SOCKET_ERROR End If End IfEnd Function Ojala te sirva.
Chao
RadicalEd:
Esta es como mas completa
Ojala te sirva.
Chao
Navegación
[#] Página Siguiente
Ir a la versión completa