PC Toledo

Código: Selecionar todos

/*
 * HMG ReadXLS Demo
 * Contributed by Isma Elias <farfa890@gmail.Com>
 */

#include "MiniGUI.ch"

#define NTrim( n ) LTRIM( STR( n, IF( n == INT( n ), 0, 2 ) ) )

Static aNamis   := {}
Static aFila    := {}
Static aWitis   := {}
Static aHojita  := {}

Static nWcrt    := 0
Static nHcrt    := 0

Function Main()

    nWcrt    := GetDesktopWidth()
    nHcrt    := GetDesktopHeight()-28

    DEFINE WINDOW winmain ;
        AT 0,0 WIDTH nWcrt HEIGHT nHcrt ;
        TITLE 'LEER UN EXCEL !!!! ' ;
        MAIN

        @050,001 GRID Grid_1 WIDTH nWcrt-03 HEIGHT nHcrt-100 ;
                 FONT "Ms Sans Serif" SIZE 09 ;
                 HEADERS { "" }    ;
                 WIDTHS { 100 }   ;
                 ITEMS  { { "" } };
                 VALUE  1

        DEFINE BUTTON cmdxls
            ROW 015
            COL 005
            WIDTH  98
            HEIGHT 24
            CAPTION "&Abrir XLS"
            FONTNAME "Ms Sans Serif"
            FONTSIZE 9
            ACTION FAR_OpenXLS()
            FLAT .T.
        END BUTTON

    END WINDOW

    winmain.Maximize()

    ACTIVATE WINDOW winmain

Return Nil


Static Function FAR_OpenXLS()

     LOCAL ccFile

     if EMPTY(ccFile) .or. ccFile==NIL .or. LEN(ccFile)=0 .or. !file(ccFile)
        ccFile := getfile({{"Archivos excel  (*.xls)","*.xls"}},"Seleccione un archivo excel",GetCurrentFolder(),.f.)
     endif

     if EMPTY(ccFile) .or. ccFile==NIL .or. LEN(ccFile)=0 .or. !file(ccFile)
        return nil
     endif

     Load_XLS_CLI( ccFile )


Return Nil


Static Function Load_XLS_CLI( cArchivo )

     LOCAL nFilas   := 0
     LOCAL nColumns := 0
     LOCAL nnColumn := 0
     LOCAL nuColumn
     LOCAL ccValue
     LOCAL i        := 0
     LOCAL j        := 0

     LOCAL oExcel   as Object
     LOCAL oWorkBook
     LOCAL oHoja
     LOCAL ccNameIs := ""

     LOCAL NoSale  := TRUE
     LOCAL nnWiti  := 0
     LOCAL aTypes  AS ARRAY

     oExcel := TOleAuto():New( "Excel.Application" )
     IF  oExcel == nil
          MsgStop('Excel no está instalado!','Error')
          RETURN Nil
     Endif

     oWorkBook := oExcel:WorkBooks:Open( cArchivo )

     oExcel:Sheets(1):Select()
     oHoja := oExcel:ActiveSheet()
     oExcel:Visible       := .F.     // <---- No Mostrar
     oExcel:DisplayAlerts := .F.     // <---- esta elimina mensajes
     //
     ************** LOOP LECTURA PLANILLA EXCEL ******************
     //
     //------------ Averiguo Cantida de Filas    ------------------
     //
     nFilas    := oHoja:UsedRange:Rows:Count()
     //
     //------------ Averiguo Cantida de Columnas ------------------
     //
     nnColumn := 0
     //
     aNamis  := {}
     //
     i := 0
     nuColumn := 0

     nColumns := Len( getProperty( "winmain", "Grid_1", "Item", 1 ) )

     DO WHILE nColumns != 0
         winmain.Grid_1.DeleteColumn( nColumns )
         nColumns--
     ENDDO

     Do While NoSale

        i := i + 1

        ccValue := AnyToString( oHoja:cells(2,i):value )
        nnWiti := GetLenColumn( LEN( ccValue )  )

	ccNameIs := AnyToString( oHoja:cells(01, i):value )
        IF EMPTY( ccNameIs ) .or. LEN( ccNameIs ) = 0 .or. ccNameIs = ' '

           nuColumn := i - 1
           NoSale := FALSE

        ELSE

           winmain.Grid_1.AddColumn( i, ccNameIs, nnWiti, 0 )
           Do Events

           AADD(aNamis, ccNameIs )
           AADD(aWitis, 120)
           nnColumn := i
        ENDIF

     EndDo
     //
     IF  nuColumn <> nnColumn

         MsgInfo("nuColumn " + str(nuColumn) +  " nnColumn " + str(nnColumn))
     ENDIF
     //
     //------------------------------------------------------------
     //
     aFila  := {}
     aTypes := {}
     //
     FOR i=2 TO nFilas Step 1

          FOR j=1 TO nnColumn Step 1

             ccValue := AnyToString( oHoja:cells(i,j):value )
             AADD(aFila, ccValue )
             AADD(aTypes, "C")

          NEXT j

          winmain.Grid_1.addItem( ItemChar(aFila, aTypes) )

          AADD(aHojita, aFila )
          aFila  := {}
          aTypes := {}
          Do Events

     Next i

     oExcel:DisplayAlerts := .F. // <---- esta elimina mensajes
     oWorkBook:Close()
     oExcel:Quit()

     oWorkBook := NIL
     oHoja := NIL
     oExcel := NIL

     winmain.title := cArchivo
     Release oWorkBook
     Release oHoja
     Release oExcel

RETURN Nil

*----------------------------------------------------------------------*
FUNCTION ItemChar(aLine, aType)
*----------------------------------------------------------------------*

    LOCAL aRet:={}, x:=0, l:=0
    aRet:=array( len(aLine) )
    l:=len(aRet)
    FOR x:=1 TO l
        do case
        case aType[x]=="N"
             aRet[x]:=NTrim(aLine[x])
        case aType[x]=="D"
             aRet[x]:=dtoc(aLine[x])
        case aType[x]=="L"
             aRet[x]:=iif(aLine[x], "TRUE", "FALSE")
        otherwise
             aRet[x]:=aLine[x]
        endcase
    NEXT

RETURN aRet


FUNCTION AnyToString(csValue)

   LOCAL ccValor := ""
   LOCAL cdate
   LOCAL cFormatoDaData := set(4)

   SET DECIMALS   TO 0

   DO CASE
   CASE Valtype(csValue) == "N"
        ccValor := AllTrim(Str(csValue))

   CASE Valtype(csValue) == "D"
        IF !Empty(csValue)
           cdate := dtos(csValue)
           ccValor := substr(cDate,1,4) + "-" + substr(cDate,5,2) + "-" + substr(cDate,7,2)
        ELSE
           ccValor := ""
        ENDIF
   CASE Valtype(csValue) == "T"
        IF !Empty(csValue)
           cdate := dtos(csValue)
           ccValor := substr(cDate,1,4) + "-" + substr(cDate,5,2) + "-" + substr(cDate,7,2)
        ELSE
           ccValor := ""
        ENDIF

   CASE Valtype(csValue) $ "CM"
        IF Empty( csValue)
           ccValor=""
        ELSE
           ccValor := "" + csValue+ ""
        ENDIF

   CASE Valtype(csValue) == "L"
        ccValor := AllTrim(Str(iif(csValue == .F., 0, 1)))

   OTHERWISE
        ccValor := ""       // NOTE: Here we lose csValues we cannot convert

   ENDCASE

RETURN( ccValor )


FUNCTION GetLenColumn( nnLen )

    LOCAL nnValor := 120
    IF nnLen < 6
       nnValor := 70
    ELSEIF nnLen < 10
       nnValor := 110
    ELSEIF nnLen < 20
       nnValor := 140
    ELSEIF nnLen < 40
       nnValor := 240
    ELSE
       nnValor := 380
    ENDIF

RETURN( nnValor )

Código: Selecionar todos

LOCAL oExcel, oSheet
LOCAL cARQ:='arquivo.xls'

TRY
   oExcel := xhb_GetActiveObject( "Excel.Application" )
CATCH
   TRY
      oExcel := xhb_CreateObject( "Excel.Application" )
   CATCH
      ? "Não foi possivel localizar o Excel instalado"
      oExcel:=NIL
   END
END
IF oExcel=NIL
   RETURN(.F.)
ENDIF

TRY
   oExcel:WorkBooks:Add()
CATCH
   ?"O Sistema não conseguiu iniciar um sessão do excel para fazer a exportação. Favor fechar todas as janelas do excel e tentar novamente."
   oExcel:=Nil
END
IF oExcel=NIL
   RETURN(.F.)
ENDIF

oSheet = oExcel:Sheets(1)

WITH OBJECT oSheet
   :Name := 'GRUPOS'

   // Titulos
   :Cells(01,01):Value = 'CodigoGrupo'
   :Cells(01,02):Value = 'CodigoGrupoPai'
   :Cells(01,03):Value = 'Descricao'

   // Celulas
   FOR mI:=1 TO LEN(aGRU)
      :Cells(mI+1,01):NumberFormat := '0'
      :Cells(mI+1,01):Value := aGRU[mI,1]
      
      :Cells(mI+1,02):NumberFormat := '0'
      :Cells(mI+1,02):Value := aGRU[mI,2]
      
      :Cells(mI+1,03):NumberFormat := '@'
      :Cells(mI+1,03):Value := aGRU[mI,3]
      
   NEXT
   :Columns:AutoFit()
END

IF FILE(cARQ)
   FERASE(cARQ)
ENDIF

oExcel:ActiveWorkBook:SaveAs(cARQ,50)

oExcel:Visible := .t.
oExcel:=NIL
oSheet:=NIL
Release oExcel
Release oSheet

Código: Selecionar todos

/*
 * Harbour Project source code
 *
 * hbole library demo/test code
 *
 * Copyright 2007 Enrico Maria Giordano e.m.giordano at emagsoftware.it
 * Copyright 2009 Mindaugas Kavaliauskas <dbtopas at dbtopas.lt>
 * Copyright 2008 Viktor Szakats (vszakats.net/harbour)
 *    Exm_CDO(), Exm_OOOpen(), Exm_CreateShortcut()
 *
 * www - http://harbour-project.org
 *
 */

#require "hbwin"

PROCEDURE Main()

   LOCAL nOption

   CLS

   DO WHILE .T.
      ? ""
      ? "Select OLE test:"
      ? "1) MS Excel"
      ? "2) MS Word"
      ? "3) MS Outlook (1)"
      ? "4) MS Outlook (2)"
      ? "5) Internet Explorer"
      ? "6) OpenOffice Calc"
      ? "7) OpenOffice Writer"
      ? "8) OpenOffice Open"
      ? "9) Send mail via CDO"
      ? "a) Read ADODB table"
      ? "b) SOAP Toolkit client"
      ? "c) PocketSOAP client"
      ? "d) Internet Explorer with callback"
      ? "e) Create shortcut"
      ? "0) Quit"
      ? "> "

      nOption := Inkey( 0 )
      ?? hb_keyChar( nOption )

      IF     nOption == hb_keyCode( "1" )
         Exm_MSExcel()
      ELSEIF nOption == hb_keyCode( "2" )
         Exm_MSWord()
      ELSEIF nOption == hb_keyCode( "3" )
         Exm_MSOutlook()
      ELSEIF nOption == hb_keyCode( "4" )
         Exm_MSOutlook2()
      ELSEIF nOption == hb_keyCode( "5" )
         Exm_IExplorer()
      ELSEIF nOption == hb_keyCode( "6" )
         Exm_OOCalc()
      ELSEIF nOption == hb_keyCode( "7" )
         Exm_OOWriter()
      ELSEIF nOption == hb_keyCode( "8" )
         Exm_OOOpen()
      ELSEIF nOption == hb_keyCode( "9" )
         Exm_CDO()
      ELSEIF nOption == hb_keyCode( "a" )
         Exm_ADODB()
      ELSEIF nOption == hb_keyCode( "b" )
         Exm_SOAP()
      ELSEIF nOption == hb_keyCode( "c" )
         Exm_PocketSOAP()
      ELSEIF nOption == hb_keyCode( "d" )
         Exm_IExplorer2()
      ELSEIF nOption == hb_keyCode( "e" )
         Exm_CreateShortcut()
      ELSEIF nOption == hb_keyCode( "0" )
         EXIT
      ENDIF
   ENDDO

   RETURN

STATIC PROCEDURE Exm_MSExcel()

   LOCAL oExcel, oWorkBook, oWorkSheet, oAS
   LOCAL nI, nCount

   IF ( oExcel := win_oleCreateObject( "Excel.Application" ) ) != NIL

      oWorkBook := oExcel:WorkBooks:Add()

      // Enumerator test
      FOR EACH oWorkSheet IN oWorkBook:WorkSheets
         ? oWorkSheet:Name
      NEXT

      // oWorkBook:WorkSheets is a collection
      nCount := oWorkBook:WorkSheets:Count()

      // Elements of collection can be accessed using :Item() method
      FOR nI := 1 TO nCount
         ? oWorkBook:WorkSheets:Item( nI ):Name
      NEXT

      // OLE also allows to access collection elements by passing
      // indices to :Worksheets property
      FOR nI := 1 TO nCount
         ? oWorkBook:WorkSheets( nI ):Name
      NEXT

      oAS := oExcel:ActiveSheet()

      // Set font for all cells
      oAS:Cells:Font:Name := "Arial"
      oAS:Cells:Font:Size := 12

      oAS:Cells( 1, 1 ):Value := "OLE from Harbour"
      oAS:Cells( 1, 1 ):Font:Size := 16

      // oAS:Cells( 1, 1 ) is object, but oAS:Cells( 1, 1 ):Value has value of the cell
      ? "Object valtype:", ValType( oAS:Cells( 1, 1 ) ), "Value:", oAS:Cells( 1, 1 ):Value

      oAS:Cells( 3, 1 ):Value := "String:"
      oAS:Cells( 3, 2 ):Value := "Hello, World!"

      oAS:Cells( 4, 1 ):Value := "Numeric:"
      oAS:Cells( 4, 2 ):Value := 1234.56
      oAS:Cells( 4, 3 ):Value := oAS:Cells( 4, 2 ):Value
      oAS:Cells( 4, 4 ):Value := oAS:Cells( 4, 2 ):Value
      oAS:Cells( 4, 3 ):Value *= 2
      oAS:Cells( 4, 2 ):Value++

      oAS:Cells( 5, 1 ):Value := "Logical:"
      oAS:Cells( 5, 2 ):Value := .T.

      oAS:Cells( 6, 1 ):Value := "Date:"
      oAS:Cells( 6, 2 ):Value := Date()

      oAS:Cells( 7, 1 ):Value := "Timestamp:"
      oAS:Cells( 7, 2 ):Value := hb_DateTime()

      // Some formatting
      oAS:Columns( 1 ):Font:Bold := .T.
      oAS:Columns( 2 ):HorizontalAlignment := - 4152  // xlRight

      oAS:Columns( 1 ):AutoFit()
      oAS:Columns( 2 ):AutoFit()
      oAS:Columns( 3 ):AutoFit()
      oAS:Columns( 4 ):AutoFit()

      oAS:Cells( 3, 2 ):Font:ColorIndex := 3  // red

      oAS:Range( "A1:B1" ):HorizontalAlignment := 7
      oAS:Range( "A3:A7" ):Select()

      oExcel:Visible := .T.

      oExcel:Quit()
   ELSE
      ? "Error: MS Excel not available. [" + win_oleErrorText() + "]"
   ENDIF

   RETURN

STATIC PROCEDURE Exm_MSWord()

   LOCAL oWord, oText

   IF ( oWord := win_oleCreateObject( "Word.Application" ) ) != NIL

      oWord:Documents:Add()

      oText := oWord:Selection()

      oText:Text := "OLE from Harbour" + hb_eol()
      oText:Font:Name := "Arial"
      oText:Font:Size := 48
      oText:Font:Bold := .T.

      oWord:Visible := .T.
      oWord:WindowState := 1 /* Maximize */
   ELSE
      ? "Error. MS Word not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_MSOutlook()

   LOCAL oOL, oList

   IF ( oOL := win_oleCreateObject( "Outlook.Application" ) ) != NIL
      oList := oOL:CreateItem( 7 /* olDistributionListItem */ )
      oList:DLName := "Distribution List"
      oList:Display( .F. )
   ELSE
      ? "Error. MS Outlook not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_MSOutlook2()

   LOCAL oOL, oLista, oMail
   LOCAL i

   IF ( oOL := win_oleCreateObject( "Outlook.Application" ) ) != NIL

      oMail := oOL:CreateItem( 0 /* olMailItem */ )

      FOR i := 1 TO 10
         oMail:Recipients:Add( "Contact" + hb_ntos( i ) + ;
            "<contact" + hb_ntos( i ) + "@server.com>" )
      NEXT

      oLista := oOL:CreateItem( 7 /* olDistributionListItem */ )
      oLista:DLName := "Test with distribution list"
      oLista:Display( .F. )
      oLista:AddMembers( oMail:Recipients )
      oLista:Save()
      oLista:Close( 0 )
   ELSE
      ? "Error. MS Outlook not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_IExplorer()

   LOCAL oIE

   IF ( oIE := win_oleCreateObject( "InternetExplorer.Application" ) ) != NIL
      oIE:Visible := .T.
      oIE:Navigate( "http://harbour-project.org" )
   ELSE
      ? "Error. IExplorer not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_IExplorer2()

   LOCAL oIE

   IF ( oIE := win_oleCreateObject( "InternetExplorer.Application" ) ) != NIL
      oIE:__hSink := __axRegisterHandler( oIE:__hObj, {| ... | QOut( ... ) } )
      oIE:Visible := .T.
      oIE:Navigate( "http://harbour-project.org" )
      WHILE oIE:ReadyState != 4
         hb_idleSleep( 0 )
      ENDDO
   ELSE
      ? "Error. IExplorer not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_OOCalc()

   LOCAL oServiceManager, oDesktop, oDoc, oSheet

   IF ( oServiceManager := win_oleCreateObject( "com.sun.star.ServiceManager" ) ) != NIL
      oDesktop := oServiceManager:createInstance( "com.sun.star.frame.Desktop" )
      oDoc := oDesktop:loadComponentFromURL( "private:factory/scalc", "_blank", 0, {} )

      oSheet := oDoc:getSheets:getByIndex( 0 )

      oSheet:getCellRangeByName( "A1" ):setString( "OLE from Harbour" )

      oSheet:getCellRangeByName( "A3" ):setString( "String:" )
      oSheet:getCellRangeByName( "B3" ):setString( "Hello, World!" )

      oSheet:getCellRangeByName( "A4" ):setString( "Numeric:" )
      oSheet:getCellRangeByName( "B4" ):setValue( 1234.56 )

      oSheet:getCellRangeByName( "A5" ):setString( "Logical:" )
      oSheet:getCellRangeByName( "B5" ):setValue( .T. )
      oSheet:getCellRangeByName( "B5" ):setPropertyValue( "NumberFormat", 99 ) // BOOLEAN

      oSheet:getCellRangeByName( "A6" ):setString( "Date:" )
      oSheet:getCellRangeByName( "B6" ):setValue( Date() )
      oSheet:getCellRangeByName( "B6" ):setPropertyValue( "NumberFormat", 36 ) // YYYY-MM-DD

      oSheet:getCellRangeByName( "A7" ):setString( "Timestamp:" )
      oSheet:getCellRangeByName( "B7" ):setValue( hb_DateTime() )
      oSheet:getCellRangeByName( "B7" ):setPropertyValue( "NumberFormat", 51 ) // YYYY-MM-DD HH:MM:SS

      oSheet:getCellRangeByName( "A3" ):setPropertyValue( "IsCellBackgroundTransparent", .F. )
      oSheet:getCellRangeByName( "A3" ):setPropertyValue( "CellBackColor", 255 ) // blue
      oSheet:getCellRangeByName( "B3" ):setPropertyValue( "CharColor", 255 * 256 * 256 ) // red
   ELSE
      ? "Error. OpenOffice not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_OOWriter()

   LOCAL oServiceManager, oDesktop, oDoc, oText, oCursor, oTable, oRow, oCell, oRows

   IF ( oServiceManager := win_oleCreateObject( "com.sun.star.ServiceManager" ) ) != NIL
      oDesktop := oServiceManager:createInstance( "com.sun.star.frame.Desktop" )
      oDoc := oDesktop:loadComponentFromURL( "private:factory/swriter", "_blank", 0, {} )

      oText := oDoc:getText
      oCursor := oText:createTextCursor

      oText:insertString( oCursor, "OpenOffice Writer scripting from Harbour." + Chr( 10 ), .F. )

      oText:insertString( oCursor, "This is the second line" + Chr( 10 ), .F. )

      oTable := oDoc:createInstance( "com.sun.star.text.TextTable" )
      oTable:initialize( 2, 4 )

      oText:insertTextContent( oCursor, oTable, .F. )

      oTable:setPropertyValue( "BackTransparent", .F. )
      oTable:setPropertyValue( "BackColor", ( 255 * 256 + 255 ) * 256 + 192 )

      oRows := oTable:getRows
      oRow := oRows:getByIndex( 0 )
      oRow:setPropertyValue( "BackTransparent", .F. )
      oRow:setPropertyValue( "BackColor", ( 192 * 256 + 192 ) * 256 + 128 )

      oCell := oTable:getCellByName( "A1" )
      oCell:insertString( oCell:createTextCursor, "Jan", .F. )
      oCell := oTable:getCellByName( "B1" )
      oCell:insertString( oCell:createTextCursor, "Feb", .F. )
      oCell := oTable:getCellByName( "C1" )
      oCell:insertString( oCell:createTextCursor, "Mar", .F. )

      // I guess we can set text without cursor creation
      oTable:getCellByName( "D1" ):setString( "SUM" )

      oTable:getCellByName( "A2" ):setValue( 123.12 )
      oTable:getCellByName( "B2" ):setValue( 97.07 )
      oTable:getCellByName( "C2" ):setValue( 106.38 )
      oTable:getCellByName( "D2" ):setFormula( "sum <A2:C2>" )

      oText:insertControlCharacter( oCursor, 0, .F. )  // PARAGRAPH_BREAK

      oCursor:setPropertyValue( "CharColor", 255 )
      oText:insertString( oCursor, "Good bye!", .F. )
   ELSE
      ? "Error. OpenOffice not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_OOOpen()

   LOCAL oOO_ServiceManager
   LOCAL oOO_Desktop
   LOCAL oOO_PropVal01
   LOCAL oOO_Doc

   LOCAL cDir

   IF ( oOO_ServiceManager := win_oleCreateObject( "com.sun.star.ServiceManager" ) ) != NIL

      hb_FNameSplit( hb_argv( 0 ), @cDir )

      oOO_Desktop := oOO_ServiceManager:createInstance( "com.sun.star.frame.Desktop" )
      oOO_PropVal01 := oOO_ServiceManager:Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
      oOO_Doc := oOO_Desktop:loadComponentFromURL( OO_ConvertToURL( hb_FNameMerge( cDir, "sample.odt" ) ), "_blank", 0, { oOO_PropVal01 } )

      ? "Press any key to close OpenOffice"
      Inkey( 0 )

      oOO_Doc:Close( .T. )
      oOO_Doc := NIL

      oOO_Desktop:Terminate()
      oOO_Desktop := NIL
      oOO_PropVal01 := NIL
   ELSE
      ? "Error: OpenOffice not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC FUNCTION OO_ConvertToURL( cString )

   // ; Handle UNC paths
   IF !( Left( cString, 2 ) == "\\" )
      cString := StrTran( cString, ":", "|" )
      cString := "///" + cString
   ENDIF

   cString := StrTran( cString, "\", "/" )
   cString := StrTran( cString, " ", "%20" )

   RETURN "file:" + cString

STATIC PROCEDURE Exm_CDO()

   LOCAL oCDOMsg
   LOCAL oCDOConf

   IF ( oCDOMsg := win_oleCreateObject( "CDO.Message" ) ) != NIL

      oCDOConf := win_oleCreateObject( "CDO.Configuration" )

      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2 // ; cdoSendUsingPort
      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := "localhost"
      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := 25
      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout" ):Value := 120
      oCDOConf:Fields:Update()

      oCDOMsg:Configuration := oCDOConf
      oCDOMsg:BodyPart:Charset := "iso-8859-2" // "iso-8859-1" "utf-8"
      oCDOMsg:To := "test@localhost"
      oCDOMsg:From := "sender@localhost"
      oCDOMsg:Subject := "Test message"
      oCDOMsg:TextBody := "Test message body"

      BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
         oCDOMsg:Send()
      RECOVER
         ? "Error: CDO send error.", win_oleErrorText()
      END SEQUENCE
   ELSE
      ? "Error: CDO subsystem not available (needs Windows XP or upper).", win_oleErrorText()
   ENDIF

   RETURN

#define adOpenForwardOnly      0
#define adOpenKeyset           1
#define adOpenDynamic          2
#define adOpenStatic           3

#define adLockReadOnly         1
#define adLockPessimistic      2
#define adLockOptimistic       3
#define adLockBatchOptimistic  4

#define adUseNone              1
#define adUseServer            2
#define adUseClient            3

STATIC PROCEDURE Exm_ADODB()

   LOCAL oRs

   IF ( oRs := win_oleCreateObject( "ADODB.Recordset" ) ) != NIL

      oRs:Open( "SELECT * FROM test ORDER BY First", ;
         "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + hb_DirBase() + "\..\..\hbodbc\tests\test.mdb", ;
         adOpenForwardOnly, ;
         adLockReadOnly )

      DO WHILE ! oRs:EOF
         ? oRs:Fields( "First" ):Value
         oRs:MoveNext()
      ENDDO

      oRs:Close()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_SOAP()

   LOCAL oSoapClient

   IF ! Empty( oSoapClient := win_oleCreateObject( "MSSOAP.SoapClient30" ) )

      oSoapClient:msSoapInit( "http://www.dataaccess.com/webservicesserver/textcasing.wso?WSDL" )

      ? oSoapClient:InvertStringCase( "lower UPPER" )
   ELSE
      ? "Error: SOAP Toolkit 3.0 not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_PocketSOAP()

   LOCAL oHttp := win_oleCreateObject( "PocketSOAP.HTTPTransport.2" )
   LOCAL oEnvelope := win_oleCreateObject( "PocketSOAP.Envelope.2" )

   IF ! Empty( oHttp ) .OR. ! Empty( oEnvelope )

      oEnvelope:EncodingStyle := ""
      oEnvelope:SetMethod( "InvertStringCase", "http://www.dataaccess.com/webservicesserver/" )
      oEnvelope:Parameters:Create( "sAString", "lower UPPER" )
      oHttp:Send( "http://www.dataaccess.com/webservicesserver/textcasing.wso?WSDL", oEnvelope:Serialize() )
      oEnvelope:Parse( oHttp )

      ? oEnvelope:Parameters:Item( 0 ):Value
   ELSE
      ? "Error: PocketSOAP not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_CreateShortcut()

   LOCAL oShell, oSC

   IF ( oShell := win_oleCreateObject( "WScript.Shell" ) ) != NIL
      oSC := oShell:CreateShortcut( hb_DirBase() + hb_ps() + "testole.lnk" )
      oSC:TargetPath := hb_ProgName()
      oSC:WorkingDirectory := hb_DirBase()
      oSC:IconLocation := hb_ProgName() + ",0"
      oSC:Save()
   ELSE
      ? "Error: Shell not available. [" + win_oleErrorText() + "]"
   ENDIF

   RETURN

Código: Selecionar todos

oSheet:getCellRangeByName( "A1" ):setString( "OLE from Harbour" )