fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
9e1b00d011c7e598c1166af8da170231749bbb38
harbour-core/harbour/contrib/hbwin/tests/testole.prg
Viktor Szakats 1b4008723b 2012-01-06 16:13 UTC+0100 Viktor Szakats (harbour syenar.net) 
* ChangeLog
  * (whole tree)
    * changed e-mail address
2012-01-06 15:28:23 +00:00

510 lines
15 KiB
Plaintext
Raw Blame History

/*
* $Id$
*/
/*
* 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 (harbour syenar.net)
* Exm_CDO(), Exm_OOOpen(), Exm_CreateShortcut()
*
* www - http://harbour-project.org
*
*/
PROCEDURE Main()
LOCAL nOption
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 )
?? Chr( nOption )
IF nOption == Asc( "1" )
Exm_MSExcel()
ELSEIF nOption == Asc( "2" )
Exm_MSWord()
ELSEIF nOption == Asc( "3" )
Exm_MSOutlook()
ELSEIF nOption == Asc( "4" )
Exm_MSOutlook2()
ELSEIF nOption == Asc( "5" )
Exm_IExplorer()
ELSEIF nOption == Asc( "6" )
Exm_OOCalc()
ELSEIF nOption == Asc( "7" )
Exm_OOWriter()
ELSEIF nOption == Asc( "8" )
Exm_OOOpen()
ELSEIF nOption == Asc( "9" )
Exm_CDO()
ELSEIF nOption == Asc( "a" )
Exm_ADODB()
ELSEIF nOption == Asc( "b" )
Exm_SOAP()
ELSEIF nOption == Asc( "c" )
Exm_PocketSOAP()
ELSEIF nOption == Asc( "d" )
Exm_IExplorer2()
ELSEIF nOption == Asc( "e" )
Exm_CreateShortcut()
ELSEIF nOption == Asc( "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" + LTRIM( STR( i, 2 ) ) + ;
"<contact" + LTRIM( STR( i, 2 ) ) + "@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
Reference in New Issue View Git Blame Copy Permalink