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.)
 

Declare Integer IsThemeActive in "UxTheme.dll" () As Long
nRet = IsThemeActive()


? "Themes: " + Iif(nRet = 0, "No activos","Activos")
 

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
 

Por: Mike Gagnon

oFrm = Createobject("myForm")
oFrm.AddObject("mGrid","myGrid")
oFrm.mGrid.column1.Width= 400
oFrm.mGrid.column1.AddObject("mycontain","myContain")
oFrm.mGrid.column1.Sparse= .F.
oFrm.mGrid.column1.CurrentControl="myContain"

oFrm.Show(1)

Define Class myForm As Form
   Width = 400
   Procedure Load
       Create Cursor mCur (Namec(10),dir c(10),Tel c(10))
       Insert Into mCur (Name,dir,Tel);
           Values ("Mike","123","555 1212")
       Insert Into mCur (Name,dir,Tel);

           Values ("John","321","555 1232")
       Insert Into mCur (Name,dir,Tel);
           Values ("Frank","111","555 5432")
       Insert Into mCur (Name,dir,Tel);
           Values ("Marie","984","555
8587")
       Insert Into mCur (Name,dir,Tel);
           Values ("Peter","827","555 3958")
       Go Top
   EndProc
EndDefine

Define Class myGrid As Grid
   ColumnCount = 1
   Width = 400
   Height = 200
   Visible = .T.

   RowHeight = 100
EndDefine

Define Class mycontain As Container
   Visible = .T.
   Width = 346
   Height = 96
   Name = "mycontain"

    Add Object text1 As TextBox With ;
       HEIGHT = 23, ;
       LEFT = 12, ;
       TOP
= 7, ;
       WIDTH = 204, ;
       NAME = "Text1",;
       CONTROLSOURCE="mCur.name"

   Add Object text2 As TextBox With ;
        HEIGHT = 23, ;
       LEFT = 12, ;
       TOP = 36, ;
       WIDTH
= 204, ;
       NAME = "Text2",;
       CONTROLSOURCE="mCur.dir"

    Add Object text3 As TextBox With ;
       HEIGHT = 23, ;
       LEFT = 12, ;
       TOP = 62, ;
       WIDTH = 204, ;
       NAME =
"Text3",;
       CONTROLSOURCE="mCur.Tel"

    Add Object label1 As Label With ;
       CAPTION = "Nombre", ;
       HEIGHT = 17, ;
       LEFT = 228, ;
       TOP = 12, ;
       WIDTH = 40, ;
       NAME =
"Label1"

    Add Object label2 As Label With ;
       AUTOSIZE = .T., ;
       CAPTION = "Dirección", ;
       HEIGHT = 17, ;
       LEFT = 228, ;
       TOP = 36, ;
       WIDTH = 48, ;
       NAME = "Label2"

    Add Object label3
As Label With ;
       CAPTION = "Teléfono", ;
       HEIGHT = 17, ;
       LEFT = 228, ;
       TOP = 60, ;
       WIDTH = 40, ;
       NAME = "Label3"
EndDefine
 

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)