USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Banco de Dados)

Título da Dica:  Abrir MDB na Internet
Postada em 24/10/2003 por [_Chuck_]            
Parte 1: ASP
Salve o código abaixo com o nome Access-Server.ASP

<%@ Language=VBScript %>
<%
dim RS, sSQL, Conn

sSQL = Request.QueryString("SQL")
if sSQL <> "" then
    ' Coloque a sua string de conexão aqui
    Conn = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=D:\bd\meumdb.mdb"
    set RS = server.CreateObject("ADODB.Recordset")
    RS.Open sSQL, Conn, 0, 3, 1
    
    ' Prepara os nomes das colunas
    for I = 0 to RS.Fields.Count - 1
        Cols = Cols & RS.Fields(I).Name & chr(254)
    next
    
    ' Prepara os dados
    do until RS.EOF
        for I = 0 to RS.Fields.Count - 1
            Dados = Dados & RS(I) & chr(254)
        next
        if right(Dados, 1) = chr(254) then Dados = left(Dados, len(Dados) - 1)
        Dados = Dados & chr(255)
        RS.MoveNext
    loop
    if right(Dados, 1) = chr(255) then Dados = left(Dados, len(Dados) - 1)
    
    ' Termina o recordset
    RS.Close
    set RS = nothing
else
    Dados = "NADA"
    Cols = "NADA"
end if
%>
<HTML>
<HEAD>
<TITLE>Access Micro Servidor</TITLE>
</HEAD>
<BODY>

<div id=Cabecalho><%=Cols%></div>

<div id=Dados><%=Dados%></div>

</BODY>
</HTML>



Parte 2: VB

Crie um novo projeto, no form desenhe 1 commandbutton, 1 MSFlexgrid, um textbox e um WebBrowser Control. Cole o código abaixo no form. Para usar digite a query no textbox e clique o botão, em alguns instantes o flexgrid será preenchido com os resultados.

Note que para funcionar vc deve estar conectado a internet.

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Private Sub Command1_Click()

    Dim URL As String
    
    ' Navega até a url
    Screen.MousePointer = vbHourglass
    DoEvents
    URL = "http://www.meuprovedor.com/minhapasta/access-server.asp?SQL=" & Text1
    WebBrowser1.Navigate URL
    
End Sub

Private Sub Form_Load()

    Command1.Caption = "Executa Query"
    
    With MSFlexGrid1
        .Cols = 1
        .Rows = 1
        .FixedCols = 0
    End With
    
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

    Dim Cab As String, Dados As String
    
    ' Extrai os dados da página recebida
    Cab = WebBrowser1.Document.All.Cabecalho.InnerText
    Dados = WebBrowser1.Document.All.Dados.InnerText
    
    If Cab <> "NADA" And Dados <> "NADA" Then
        MostraDados Cab, Dados
        Screen.MousePointer = vbDefault
    Else
        Screen.MousePointer = vbDefault
        MsgBox "Nada a Exibir", vbInformation
    End If

End Sub

Sub MostraDados(ByVal Cab As String, ByVal Dados As String)

    Dim CORPO As Variant, CABEC As Variant, TMP As Variant
    
    CORPO = Split(Dados, Chr(255))
    CABEC = Split(Cab, Chr(254))
    
    With MSFlexGrid1
        ' Paralisa o update de tela
        LockWindowUpdate .hWnd
        
        ' Poe o cabeçalho
        .Cols = UBound(CABEC)
        .Row = 0
        For I = 0 To UBound(CABEC) - 1
            .Col = I
            .Text = CABEC(I)
        Next
        
        ' Poe os dados
        For I = 0 To UBound(CORPO)
            CORPO(I) = Replace(CORPO(I), Chr(254), vbTab)
            .AddItem CORPO(I)
        Next
        
        ' retorna ao normal
        LockWindowUpdate 0
    End With
    
End Sub
 


CyberWEB Network Ltda.    © Copyright 2000-2021   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página