PureBasic Forums - English

Code: Select all

    
Dim FileName As String
Dim FileStream As New SpFileStream
Dim Voice As  SpVoice

'Create a  SAPI voice
Set Voice = New SpVoice
	
'The output audio data will be saved to ttstemp.wav file
FileName = "c:\ttstemp.wav"
	
'Create a file; set DoEvents=True so TTS events will be saved to the file
FileStream.Open FileName, SSFMCreateForWrite, True

'Set the output to the FileStream
Set Voice.AudioOutputStream = FileStream
	
'Speak the text
Voice.Speak "hello world"

'Close the Stream
FileStream.Close

'Release the objects
Set FileStream = Nothing
Set Voice = Nothing

Code: Select all

IncludePath "..\..\"
XIncludeFile "COMatePLUS.pbi"

Define.COMateObject virtualbox, machine, session

virtualbox = COMate_CreateObject("VirtualBox.VirtualBox")

If virtualbox
  Debug "VirtualBox Version " + virtualbox\GetStringProperty("Version") ; works
  machine = virtualbox\GetObjectProperty("findMachine('WinXP_SP3')") ; change to a real vm
  If machine
    Debug machine\GetStringProperty("id") ; works
    session  = COMate_CreateObject("VirtualBox.Session") ; <- doesn't work
    If session
      Debug "session"
      session\Release()
    EndIf
    machine\Release()
  EndIf

  virtualbox\Release()
EndIf

Code: Select all

'
' Copyright (C) 2009 Oracle Corporation
'
' This file is part of VirtualBox Open Source Edition (OSE), as
' available from http://www.virtualbox.org. This file is free software;
' you can redistribute it and/or modify it under the terms of the GNU
' General Public License (GPL) as published by the Free Software
' Foundation, in version 2 as it comes in the "COPYING" file of the
' VirtualBox OSE distribution. VirtualBox OSE is distributed in the
' hope that it will be useful, but WITHOUT ANY WARRANTY of any kind.
'

Sub Print(str)
   Wscript.Echo str
End Sub

Sub StartVm(vb, mach)
  Dim session, progress

  Set session = CreateObject("VirtualBox.Session")
  Set progress = vb.openRemoteSession(session, mach.id, "gui", "")
  progress.waitForCompletion(-1)
  session.close()
End Sub


Sub StopVm(vb, mach)
  Dim session, progress

  Set session = CreateObject("VirtualBox.Session")
  vb.openExistingSession session, mach.id
  session.console.powerDown().waitForCompletion(-1)
  session.close()
End Sub


Sub Main
   Dim vb, mach

   set vb = CreateObject("VirtualBox.VirtualBox")
   Print "VirtualBox version " & vb.version

   ' Safe arrays not fully functional from Visual Basic Script, as we
   ' return real safe arrays, not ones wrapped to VARIANT and VBS engine
   ' gets confused. Until then, explicitly find VM by name.
   ' May wish to use hack like one described in
   ' http://www.tech-archive.net/Archive/Excel/microsoft.public.excel.programming/2006-05/msg02796.html to handle safearrays
   ' if desperate

   Set mach = vb.findMachine("WinXP_SP3")
   Print "Machine: " & mach.name  & " ID: " & mach.id

   StartVm vb, mach
End Sub

Main

Code: Select all

IncludePath #PB_Compiler_Home + "srod\comateplus\"
XIncludeFile "comateplus.pbi"

EnableExplicit

Define.COMateObject VirtualBox, Machine, Session, Progress
Define.s MachineID

VirtualBox = COMate_CreateObject("VirtualBox.VirtualBox")

If VirtualBox
  
  Debug "VirtualBox-Version: " + VirtualBox\GetStringProperty("Version") 
  
  Machine = VirtualBox\GetObjectProperty("findMachine('Xubuntu')")
  
  If Machine
    
    MachineID = Machine\GetStringProperty("id")
    
    Debug "Machine-ID: " + MachineID
    
    Machine\Release()
    
    Session = COMate_CreateObject("VirtualBox.Session") 
    
    If Session
      
      Progress = VirtualBox\GetObjectProperty("openRemoteSession(" + Str(Session) + " As COMateObject, '" + MachineID + "', 'gui', '')")
      
      If Progress
        Progress\Invoke("waitForCompletion(-1)")
        Progress\Release()
      Else
        Debug "!Progress: " + COMate_GetLastErrorDescription()
      EndIf
      
      Session\Invoke("close()")
      Session\Release()
      
    Else
      Debug "!Session: " + COMate_GetLastErrorDescription()
    EndIf
    
  Else
    Debug "!Machine: " + COMate_GetLastErrorDescription()
  EndIf
  
  VirtualBox\Release()
  
Else
  Debug "!VirtualBox: " + COMate_GetLastErrorDescription()
EndIf

Code: Select all

Procedure.i COMate_GetObject(file$, progID$="", blnInitCOM = #True)
  Protected *this._membersCOMateClass, hResult = #E_OUTOFMEMORY, iPersist.IPERSISTFILE, clsid.CLSID, cf.IClassFactory, iUnknown.IUNKNOWN
  Protected bstr1, t1
  If blnInitCOM 
    CoInitialize_(0)
  EndIf
  If file$ Or progID$
    *this = AllocateMemory(SizeOf(_membersCOMateClass))
    If *this
      *this\vTable = ?VTable_COMateClass
      If file$
        If progID$ = ""
          ;Here we attempt to create an object based upon the filename only.
            bstr1 = COMate_MakeBSTR(file$)
            If bstr1 ;If an error then hResult already equals #E_OUTOFMEMORY!
              hResult = CoGetObject_(bstr1, 0, ?IID_IDispatch, @*this\iDisp)
              SysFreeString_(bstr1)
            EndIf
        Else
          ;Here we attempt to create an object based upon the filename and the progID.
            bstr1 = COMate_MakeBSTR(progID$)
            If bstr1
              hResult = CLSIDFromProgID_(bstr1, @clsid)
              If SUCCEEDED(hResult)
                hResult = CoGetClassObject_(clsid, #CLSCTX_LOCAL_SERVER|#CLSCTX_INPROC_SERVER, 0, ?IID_IClassFactory, @cf)
                If SUCCEEDED(hResult)
                  hResult = cf\CreateInstance(0, ?IID_IPersistFile, @iPersist)
                  If SUCCEEDED(hResult)
                    hResult = iPersist\Load(file$, 0)
                    If SUCCEEDED(hResult)
                      hResult = iPersist\QueryInterface(?IID_IDispatch, @*this\iDisp)
                    EndIf
                  EndIf
                  If iPersist
                    iPersist\Release()
                  EndIf
                EndIf
                If cf
                  cf\Release()
                EndIf
              EndIf
            EndIf
            If bstr1
              SysFreeString_(bstr1)
            EndIf
        EndIf
      Else
        ;Here we attempt to create a new COMate object containing a new instance of a currently active object.
          bstr1 = COMate_MakeBSTR(progID$)
          If bstr1
            If Left(progID$, 1) = "{"
              hResult = CLSIDFromString_(bstr1, @clsid)
              If SUCCEEDED(hResult)
                hResult = ProgIDFromCLSID_(clsid, @t1)
                If SUCCEEDED(hResult) And t1
                  SysFreeString_(t1)
                EndIf
              EndIf
            Else
	  	        hResult = CLSIDFromProgID_(bstr1, @clsid);
	          EndIf
            If SUCCEEDED(hResult)
              hResult = GetActiveObject_(clsid, 0, @iUnknown)
              If SUCCEEDED(hResult)
                hResult = iUnknown\QueryInterface(?IID_IDispatch, @*this\iDisp)
              EndIf
              If iUnknown
                iUnknown\Release()
              EndIf
            EndIf
            SysFreeString_(bstr1)
          EndIf
      EndIf
    EndIf
  Else
    hResult = #E_INVALIDARG
  EndIf
  If SUCCEEDED(hResult)
    COMate_gNumObjects+1
  ElseIf *this
    FreeMemory(*this)
    *this = 0
  EndIf
  CompilerIf Defined(COMATE_NOERRORREPORTING, #PB_Constant)=0
    COMateClass_INTERNAL_SetError(*this, hResult)
  CompilerEndIf
  ProcedureReturn *this
EndProcedure

Code: Select all

Define.COMateObject ALObject
ALObject = COMate_CreateObject("ActiveLock3.IActiveLock")

Code: Select all

229            hResult = CoGetClassObject_(clsid, #CLSCTX_LOCAL_SERVER|#CLSCTX_INPROC_SERVER, 0, ?IID_IClassFactory, @cf)