Exemplo que mostra como fazer uma busca para seu site.
Créditos: J. Halles
Baixe o exemplo de uma calculadora básica desenvolvida em Visual Basic.
Exemplo com fontes de como criar cruds no VB.
Exemplo prático com fontes..
Exemplo prático de como acessar base de dados DBF com VB.
'Microsoft SQL Server ODBC Driver example
cnstr = "driver={SQL Server};server=myserver;" & _
"database=pubs;uid=sa;pwd="
cn.Connect = cnstr
'Microsoft Access ODBC Driver example (version 2.x)
cnstr = "Driver={Microsoft Access Driver (*.mdb)};" & _
"Dbq=c:\program files\devstudio\vb\biblio.mdb;" & _
"Uid=Admin; Pwd="
cn.Connect = cnstr
'Microsoft ODBC Driver for Oracle example
cnstr = "Driver={Microsoft ODBC Driver for Oracle};" & _
"Server=OracleServer.world; Uid=demo; Pwd=demo"
' Note that 1.0 version of the Microsoft Oracle driver used
' "ConnectString" notation instead of "Server"
NOTE: O nome do driver precisa estar entre {}, assim : “{SQL Server}”
Existem três maneiras de abrir uma objeto conexão (Connection Object) usando a ADO:
Configurando a propriedade ConnectionString com uma Connect String válida e chamando o método Open(). Esta string de conexão depende de um provedor OLEDB.
Passando uma Connect String valida para o primeiro argumento do método Open()
Passando o OBDC DSN (Data Source Name) e opcionalmente a identificação e a senha para o objeto Connection via método Open()
Existem três maneiras de abrir um Objeto Recordset usando a ADO:
Abrindo um Recordset usando o método Execute(). Sem um objeto Connection.
Abrindo um Recordset usando o método Execute(). Sem um objeto Command.
Abrindo um objeto Recordset sem um objeto Connection ou Command e passando um string de conexão válida para o segundo argumento do Recordset. Usando o método Open().
Vejamos abaixo os exemplos:
Private Sub cmdOpen_Click()
Dim Conn1 As New adodb.Connection
Dim Cmd1 As New adodb.Command
Dim Errs1 As Errors
Dim Rs1 As New adodb.Recordset
Dim i As Integer
Dim AccessConnect As String
' Error Handling Variables
Dim errLoop As Error
Dim strTmp As String
AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
"Dbq=nwind.mdb;" & _
"DefaultDir=C:\vb6;" & _
"Uid=Admin;Pwd=;"
'---------------------------------------
' Métodos do Object Connection
'---------------------------------------
On Error GoTo AdoError ' Tratamento de erros
' Connection object
' Connection Open método 1 - Open via ConnectionString Property
Conn1.ConnectionString = AccessConnect
Conn1.Open
Conn1.Close
Conn1.ConnectionString = ""
' Connection Open metodo 2 - Open("[ODBC Connect String]","","")
Conn1.Open AccessConnect
Conn1.Close
' Connection Open metodo 3 - Open("DSN","Uid","Pwd")
Conn1.Open "Driver={Microsoft Access Driver (*.mdb)};" & _
"DBQ=nwind.mdb;" & _
"DefaultDir=C:\program files\devstudio\vb;" & _
"Uid=Admin;Pwd=;"
Conn1.Close
'---------------------------------
' Métodos do Recordset Object
'---------------------------------
' Não assume que temos um connection object.
On Error GoTo AdoErrorLite
' Recordset Open Metodo 1 - Open via Connection.Execute(...)
Conn1.Open AccessConnect
Set Rs1 = Conn1.Execute("SELECT * FROM Employees")
Rs1.Close
Conn1.Close
' Recordset Open Metodo 2 - Open via Command.Execute(...)
Conn1.ConnectionString = AccessConnect
Conn1.Open
Cmd1.ActiveConnection = Conn1
Cmd1.CommandText = "SELECT * FROM Employees"
Set Rs1 = Cmd1.Execute
Rs1.Close
Conn1.Close
Conn1.ConnectionString = ""
' Recordset Open Metodo 3 - Open sem Connection & e sem Connect String
Rs1.Open "SELECT * FROM Employees", AccessConnect, adOpenForwardOnly
Rs1.Close
Done:
Set Rs1 = Nothing
Set Cmd1 = Nothing
Set Conn1 = Nothing
Exit Sub
AdoError:
i = 1
On Error Resume Next
'numera a coleção erros e mostra as propriedades de cada objeto error
Set Errs1 = Conn1.Errors
For Each errLoop In Errs1
With errLoop
strTmp = strTmp & vbCrLf & "ADO Error # " & i & ":"
strTmp = strTmp & vbCrLf & " ADO Error # " & .Number
strTmp = strTmp & vbCrLf & " Description " & .Description
strTmp = strTmp & vbCrLf & " Source " & .Source
i = i + 1
End With
Next
AdoErrorLite:
' Informação do objeto Error do VB
strTmp = strTmp & vbCrLf & "VB Error # " & Str(Err.Number)
strTmp = strTmp & vbCrLf & " Generated by " & Err.Source
strTmp = strTmp & vbCrLf & " Description " & Err.Description
MsgBox strTmp
' Encerra o tratamento de erros
On Error GoTo 0
GoTo Done
End Sub
Function GetCurrentPrinterHandle: THandle;
Const
Defaults: TPrinterDefaults = (
pDatatype : nil;
pDevMode : nil;
DesiredAccess : PRINTER_ACCESS_USE or PRINTER_ACCESS_ADMINISTER
);
Var
Device, Driver, Port : array[0..255] of char;
hDeviceMode: THandle;
Begin { GetCurrentPrinterHandle }
Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
If not OpenPrinter(@Device, Result, @Defaults) Then
RaiseLastWin32Error;
End; { Pega o handle da impressora padrão }
{ mata todos os trabalhos da impressora }
Procedure PurgeJobsOnCurrentPrinter;
Var
hPrinter: THandle;
Begin
hPrinter:= GetCurrentPrinterHandle;
try
If not WinSpool.SetPrinter( hPrinter, 0, nil,
PRINTER_CONTROL_PURGE )
Then
RaiseLastWin32Error;
finally
ClosePrinter( hPrinter );
end;
End;
Chame utilizando a procedure, assim…
PurgeJobsOnCurrentPrinter;
procedure Imprimir; var iPrinter: TPrinter; PrinterY: Integer; begin iPrinter:= TPrinter.Create; PrinterY:= 0; iPrinter.Title:= 'MEUSISTEMA - Cupom'; //Se a impressora estiver imprimindo, espera While Printer.Printing Do Sleep(100); iPrinter.BeginDoc; iPrinter.Canvas.Font.Name:='Courier'; iPrinter.Canvas.Font.Style:=[fsBold]; iPrinter.Canvas.Font.Size:=13; iPrinter.Canvas.Font.Size:=18; iPrinter.Canvas.TextOut(0,PrinterY,'CUPOM TESTE SISTEMA'); Inc(PrinterY,38); iPrinter.Canvas.Font.Size:=13; iPrinter.Canvas.TextOut(0,PrinterY,'TESTE'); Inc(PrinterY,30); iPrinter.Canvas.TextOut(0,PrinterY,'--------------------'); Inc(PrinterY,30); iPrinter.Canvas.Font.Size:= 18; iPrinter.Canvas.TextOut(0,PrinterY,'OUTRO TESTE'); Inc(PrinterY,50); iPrinter.EndDoc; iPrinter.Free;