Cita:
Iniciado por marcos1979 Disculpa pero no entiendo, podrias poner el codigo aca asi vemos bien que es lo que necesitas???
'***************CLIENTE**********
Option Explicit
Public str_contenido_archivo As String, str_nombre_archivo As String, str_ruta_remota As String
Dim lng_tamaño_archivo As Long
Public oXML As XMLExport.clsXMLExport
Public NUMSOCKETS As Integer
Public myCommand As ADODB.Command
Public myConnection As ADODB.Connection
Public myRecordSet As ADODB.Recordset
Public Function CONECTAR(User As String, Password As String, SQL_instruction As String)
'esta fucnion recibe usuario, password e instrucciones que se quiere hacer para ponerlo en un Datagrid
Dim Archivo As String
Dim Comando As String
Dim STRXML As String
Dim oXML As New clsXMLExport
Archivo = "C:\XMLFile.xml"
Set myConnection = New ADODB.Connection
Set myCommand = New ADODB.Command
Set myRecordSet = New ADODB.Recordset
myConnection.ConnectionString = "Provider= SQLOLEDB.1;Persist Security Info= False;Password=" & Password & ";User ID=" & User & ";Initial Catalog=DBTURISMO;Data Source=MARCOS"
myConnection.Open
myCommand.ActiveConnection = myConnection
myRecordSet.Open SQL_instruction, myConnection, adOpenStatic, adLockOptimistic
On Error GoTo NOEXISTE
Kill (Archivo)
NOEXISTE:
myRecordSet.save Archivo, adPersistXML
'abrimos el archivo seleccionado pero en código binario
Open Archivo For Binary As #1
'almacenamos el contenido en una variable string
Me.str_contenido_archivo = Input(LOF(1), 1)
Close #1
lng_tamaño_archivo = Len(str_contenido_archivo)
End Function
Public Function CNX_OPEN(Servidor As String)
If Servidor = "" Then Servidor = "."
Set myConnection = New ADODB.Connection
Set myCommand = New ADODB.Command
Set myRecordSet = New ADODB.Recordset
myConnection.CursorLocation = adUseClient
myConnection.ConnectionTimeout = 30
myConnection.ConnectionString = "Driver={SQL Server};Server=" & Servidor & ";user=03420012;password=zamora;database=dbturismo "
myConnection.Open
myCommand.ActiveConnection = myConnection
End Function
Public Function COMMANDO(SQL As String)
myCommand.ActiveConnection = myConnection
myCommand.CommandType = adCmdText
myCommand.CommandTimeout = 30
myCommand.CommandText = SQL
Set myRecordSet = myCommand.Execute
End Function
Private Sub Command1_Click()
Call CONECTAR("mcssnt", "marcos", "select * from empresa")
End Sub
Private Sub Form_Load()
Me.Caption = Winsock1(0).LocalHostName & ": " & Winsock1(0).LocalIP
Winsock1(0).LocalPort = 666
Print "escuchando puerto " & Winsock1(0).LocalPort
Winsock1(0).Listen
End Sub
Private Sub Winsock1_Close(Index As Integer)
Print "Conexion cerrada: " & Winsock1(Index).RemoteHostIP
Winsock1(Index).Close
Unload Winsock1(Index)
NUMSOCKETS = NUMSOCKETS - 1
End Sub
Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Print "Id de la solicitud de conexion: "; requestID & " de "; Winsock1(Index).RemoteHostIP
NUMSOCKETS = NUMSOCKETS + 1
Load Winsock1(NUMSOCKETS)
Winsock1(NUMSOCKETS).Accept requestID
Winsock1(0).Close
Winsock1(0).Listen
End Sub
Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim vtData As String
Dim vtReturn As String
Winsock1(Index).GetData vtData, vbString
If Mid(vtData, 1, 6) = "Imagen" Then 'si es una direccion para una imagen lo hacemos
Dim Archivo As String
Dim X As Integer
For X = 7 To 64
If Not Mid(vtData, X, 1) = "|" Then
Archivo = Archivo & Mid(vtData, X, 1)
Else
Exit For
End If
Next X
'abrimos el archivo seleccionado pero en código binario
Open Archivo For Binary As #1
'almacenamos el contenido en una variable string
str_contenido_archivo = Input(LOF(1), 1)
Close #1
'la propiedad 'FileTitle' me devuelve el nombre del archivo selccionadoç
'el cual almaceno en la variable '.str_nombre_archivo'
'Me.str_nombre_archivo = Me<.cd_directorio.FileTitle
lng_tamaño_archivo = Len(str_contenido_archivo)
' Winsock1(Index).SendData lng_tamaño_archivo & "|" & str_contenido_archivo
End If
If INTERPRETA(vtData) = "Conectado" Then 'entonces se coneto e interpreta el codigo XML y lo pone en el recordset
'mandamos archivo
'Winsock1(Index).SendData "archivo|" & "c:\windows\temp\xmlfile.xml" & "|" & lng_tamaño_archivo & "|" & str_contenido_archivo
Winsock1(Index).SendData lng_tamaño_archivo & "|" & str_contenido_archivo
Else
'mensaje de error
Winsock1(Index).SendData "Error"
End If
End Sub
Public Function INTERPRETA(STRXML As String) As String
Dim User_ As String
Dim Pass_ As String
Dim SQL_instruction As String
Dim DOC As DOMDocument
Dim Cadena As IXMLDOMNodeList
Set DOC = New DOMDocument
' DOC.Load (strXML)
DOC.loadXML (STRXML)
'seleccionamos
Set Cadena = DOC.selectNodes("XML/USER")
User_ = Cadena.Item(0).Text
Set Cadena = DOC.selectNodes("XML/PASSWORD")
Pass_ = Cadena.Item(0).Text
Set Cadena = DOC.selectNodes("XML/PETICION")
SQL_instruction = Cadena.Item(0).Text
On Error GoTo NO
Call CONECTAR(User_, Pass_, SQL_instruction)
' Set xml = myRecordSet
INTERPRETA = "Conectado"
Exit Function
NO:
INTERPRETA = "Desconectado"
End Function
'******** SERVIDOR *********
El servidor si hace lo suyo, solo ke necesita la peticion del cliente, la cual tengo que ir manejando por clics primero
Private Sub cmdConect_Click()
Winsock1.RemoteHost = InputBox("Introduzca host remoto (IP) ", , Winsock1.LocalIP)
Winsock1.RemotePort = 666
Winsock1.Connect
End Sub
Luego va el segundo clic que manda el query al server
Private Sub Command11_Click()
Dim XML As String
Dim DOC As DOMDocument
Dim XMLL As IXMLDOMElement
Dim PETICION As IXMLDOMElement
Dim DATO As IXMLDOMElement
Dim STRXML As Variant
Set DOC = New DOMDocument
Set XMLL = DOC.createElement("XML")
DOC.appendChild XMLL
Set DATO = DOC.createElement("USER")
DATO.Text = "mcssnt"
XMLL.appendChild DATO
Set DATO = DOC.createElement("PASSWORD")
DATO.Text = "marcos"
XMLL.appendChild DATO
Set DATO = DOC.createElement("PETICION")
DATO.Text = "select ID_EMPRESA,NOMBRE,TELEFONO from EMPRESA WHERE ID_GIRO=1" 'ID_GIRO=1 IGSON LOS CINES
XMLL.appendChild DATO
STRXML = XMLL.Text
'Winsock1.SendData InputBox("datos a enviar", , DOC.XML)
Winsock1.SendData DOC.XML
End Sub
Ya que este generado el XML es enviado y el servidor lo recibe sin ningun problema ya solo ponemos el xml que no regresa el servidor en un datagrid
Private Sub Command12_Click()
Set dtgListaCines.DataSource = XML2RS("c:\windows\temp\myxml.xml")
Kill ("c:\windows\temp\myxml.xml")
End Sub
el codigo de esos 3 botones quiero ponerlo en un solo boton, pero no funciona por qu ela llamada de winsock la hace hasta encontrar el end sub.
¿quieres que ponga la parte del servidor?
