Set Library To Sys(2004)+"fpsql.fll"

Public errval, errmsg, handle
errval=0

errmsg=" "
SourceName= "test"
User=
"sa"
passwd=""

* Conexión
handle=DBConnect(SourceName,User,passwd)

If handle > 0
   Wait Window
"Conectado" Nowait
Else
   Err=DBError(0,@errmsg,@errval)
   Wait Window Str(errval)+" "+errmsg
Endif

=DBSetOpt(handle,"Asynchronous",0)

=DBSetOpt(handle,"BatchMode",1)
=DBSetOpt(handle,"ConnTimeout",0)
=DBSetOpt(handle,"Transact",1)
=DBSetOpt(handle,"UseTable",0)

err=DBExec(handle,"use pubs")


If Err < 0
   =MessageBox("Error")
   Return .F.
EndIf


SqlCmd= "Execute ConsultarOrden '25'"
err=DBExec(handle,SqlCmd)

If err > 0
   Browse
Else
   =MessageBox("Error")

   Return .F.
Endif

*Desconexión
err=DBDisconn(handle)
 

oWSH = Createobject("WScript.Network")
oImp = oWSH.EnumPrinterConnections()


For i=1 To oImp.Count-1
   ?oImp.Item(i)
Endfor

Public oTbr
oTbr = Createobject("MyToolBar")
oTbr.Visible
= .T.

Define Class MyToolBar As Toolbar
   Caption = "Sync toolbar with menu"
   Add Object cmd1 As CommandButton With;

       caption = "File New"

   Add Object cmd2 As CommandButton With;
       caption = "File Menu"


   Add Object cmd3 As CommandButton With;
       caption = "Spell Check"

   Add Object cmd4 As CommandButton With;

       caption = "Help Search"

   Procedure cmd1.Click
       Keyboard "{ctrl+n}"
   Endproc

   
Procedure cmd2.Click
       Keyboard "{alt+f}"
   Endproc

   Procedure cmd3.Click
       Keyboard "{alt+t}S"
   Endproc

   
Procedure cmd4.Click
       Keyboard "{alt+h}s"
   Endproc

Enddefine
 

Existe una librería llamada FPSQL.FLL que permite conectarse a diversas bases de datos a través de ODBC dede Fox 2.6; La librería FLL posee casi las mismas funciones que VFP para conectarse a través de ODBC.

DbGetOpt()
DBSetOpt()
DBConnect()
DBDisconn()
DBExec()
DBTransact()
DbTables()

Entre otras.....

Use Home(2)+"Dataorders.dbf"Shared

oWord = CreateObject("Word.Application")
oDoc = oWord.Documents.Add()
oRange = oDoc.Range()
oDoc.Tables.Add(oRange, 20, 2)

oTable = oDoc.Tables(1)

With oTable
  .Cell(1, 1).Range.Font.Size= "10"
  .Cell(1, 1).Range.Font.Name= "Arial"
  .Cell(1, 1).Shading.BackgroundPatternColor = 0
  .Cell(1, 1).Range.Font.Color
= 16777215
  .Cell(1, 1).Range.Text= "Vendedor"
  .Cell(1, 2).Range.Font.Size= "10"
  .Cell(1, 2).Range.Font.Name= "Arial"
  .Cell(1, 2).Range.Font.Color
= 16777215
  .Cell(1, 2).Shading.BackgroundPatternColor = 0
  .Cell(1, 2).Range.Text= "Total de la venta"
EndWith

nPos = 2
Scan For Recno() <= 20
  nPos = nPos + 1

  With oTable
    .Cell(nPos, 1).Range.Font.Color= 0
    .Cell(nPos, 1).Range.Text= Cust_Id
    .Cell(nPos, 1).Shading.BackgroundPatternColor = 15132390

    If
Order_Amt <= 600 Then
      .Cell(nPos, 2).Shading.BackgroundPatternColor = 65535
    Else
      .Cell(nPos, 2).Shading.BackgroundPatternColor = 8454016
    EndIf

   .Cell(nPos, 2).Range.Font.Color= 1
   .Cell(nPos, 2).Range.Text= Transform(Order_Amt)

   EndWith
EndScan

Use In Orders
oWord.Visible = .T.

En el ejemplo se deshabilitaran los Themes de WinXP y después de 5 segundos se reestablecerán.

Declare Integer EnableTheming In "UxTheme.dll"
Integer nEnable

=EnableTheming(.F.)
Inkey(5, "H")
=EnableTheming(.T.)
 

Ideal para cuando la tabla a exportar no tiene muchos campos y registros.

oExcel = Createobject("Excel.Application")
oExcel.WorkBooks.Add


Use Home()+"samplesdataCustomer"Shared
Set Talk Off

nNumRegExp = 15 && Reccount()

For i= 1 To nNumRegExp
   For J = 1
To Fcount()
       oExcel.ActiveSheet.cells(i,J).Value= Eval(Field(J))
   Next
   Skip
Next

oExcel.Visible
= .T.
 

oMail = Createobject("jmail.SMTPMail")
oMail .ServerAddress = "mail.dominio.com"
oMail.AddRecipient ("destinatario@dominio.com")
oMail.Sender = "quienenvia@dominio.com"
oMail.SenderName = "Nombre quien envia"

oMail.Subject = "Titulo del email"
oMail.Body = "Texto del email"
oMail.AddAttachMent ("C:
utaarchivo.txt")
nRet = oMail.Execute()

If nRet != 0
   =Messagebox(Transform(oMail.errorCode))
EndIf

Release oMail

oCata = CreateObject("ADOX.Catalog")
cCadBD = "Provider=Microsoft.Jet.OLEDB.4.0;"+;
           "Data Source = C:MiBaseDeDatos.mdb;"

* Crea la base de datos
oCata.Create(cCadBD)

oCata.ActiveConnection = cCadBD


oTabla = CreateObject("ADOX.Table")

* Nombre de la nueva tabla
oTabla.Name = "Alumnos"

nTipoInt = 3
nTipoFecha = 7
nTipoVarChar = 202
* El último parámetro es el ancho del campo

* Agregando campos a tabla Alumnos
With oTabla.Columns
   .Append("CodiAlum",
nTipoInt)
   .Append("Apellidos", nTipoVarChar, 70)
   .Append("Nombres", nTipoVarChar, 70)
   .Append("FecNace", nTipoFecha)
   .Append("Direccion", nTipoVarChar, 200)
EndWith

* Agrego la tabla
oCata.Tables.Append(oTabla)

Release oTabla, oCata

 
 

Para probar el ejemplo crea un reporte llamadortfdemo.frx y agrégale un control RTF, le colocas como control source ctext.gText y le marcas la opción que dice "Campo general de una tabla"

Local cStr

cStr="Note that there is a limit of 32 characters "+;

   "total for the sum of text before and text "+;

   "after for simple numbering. Multilevel numbering "+;
   "has a limit of 64 characters total for the sum "+;

   "of all levels.NOTE: The file must have a"+;
   ".RTF extension to work properly."+;
   "Note that there is a limit of 32 characters "+;

   "total for the sum of text before and text "+;
   "after for simple numbering. Multilevel numbering "+;
   "has a limit of 64 characters total for the sum "+;

   "of all levels.NOTE: The file must have a"+;
   ".RTF extension to work properly."

Create Cursor ctext (lctext m,gText g)
Insert Into ctext (lctext)
Values (cStr)

_rtfFile = "c:"+Sys(3)+".rtf"

Scan
   Set Textmerge To &_rtfFile Noshow
   Set Textmerge On
   \{
tf1ansiqj <<ALLT(cText.lcText)>>}
   
Set Textmerge To
   Append General gText From &_rtfFile Class "RICHTEXT.RICHTEXTCTRL.1"
EndScan

Report Form rtfdemo.frx Preview Noconsole
 

oCata = CreateObject("ADOX.Catalog")

cCadCon = "Provider=Microsoft.Jet.OLEDB.4.0;"+;
           
"Data Source = C:Nwind.mdb;"+ ;
           "User ID=;" +;
            "Password=;"

oCata.ActiveConnection = cCadCon

oCmd = CreateObject("ADODB.Command")

* Comando a ejecutar en la vista (consulta)
oCmd.CommandText = "Select * From Empleados"

oCata.Views.Append("VistaEmpleados", oCmd)

Release oCmd, oCata

Esto te devolverá los nombres de todos los equipos que se encuentran en la RED con el nombre que le pases..


ANetResources(APcs,
"NOMBRE-RED",1)

For i = 1 to Alen(APcs)
   ? APcs(i)
Next
 

Existen diversas formas de terminarlo ... la primera:

nAño = 2004
? !Empty(Date(nAño,
02, 29))

nAño = 2005
? !Empty(Date(nAño, 02, 29))
 

Otra forma utilizando MOD

?Mod(2004, 4)
?Mod(2005, 4)
 

oRep =Createobject("Form")

With oRep
    .Caption= "Titulo del Reporte"
    .WindowState= 2

    .Show()
Endwith

Report Form MiReporte.frx Preview Window (oRep.Name)

En este ejemplo vamos a buscar en la tabla los productos cuyo nombre es "producto" sin importar como lo escriba el usuario

Create Cursor MiTabla(NomProd C(30))

Insert Into MiTabla Values("Producto 1")

Insert Into MiTabla Values("eL PrOduCtO 2")
Insert Into MiTabla Values("prodUCTO 3")
Insert Into MiTabla Values("Mi
PRODUCTO X")
Insert Into MiTabla Values("Otro")
Insert Into MiTabla Values("re Otro")

cValBus = "pRodUctO"
Select * From
MiTabla Where Atc(cValBus,NomProd) > 0