IMAPI v2.x

[AUGE_OHR]

hi,

seit XP gibt es ja ein "Brenner" Service IMAPI. Seit Vista gibt es die v2.x Version
XP benötigt das Update http://support.microsoft.com/kb/932716

nun habe ich gelesen*** das v2.x als DLL läuft und nicht mehr als Service was den "Zugriff" erleichtern könnte ... ?
***http://msdn.microsoft.com/en-us/library ... 85%29.aspx

die Beispiele sind alle als VBScript ausgelegt ... startete man die über den IE ?

hat da schon jemand Erfahrung mit der v2.x ?
... von der v1.x weiss ich das Hannes Ziegler damals was mit YUKON gemacht hat.

[AUGE_OHR]

moin,

dieses VbScript "brennt" mir eine CD ( mit KB932716 )

Code: Alles auswählen

' This script burns data files to disc in a single session
' using files from a single directory tree.

' Copyright (C) Microsoft Corp. 2006

Option Explicit

' *** CD/DVD disc file system types
Const FsiFileSystemISO9660 = 1
Const FsiFileSystemJoliet  = 2
Const FsiFileSystemUDF102  = 4

WScript.Quit(Main)

Function Main
    Dim Index                ' Index to recording drive.
    Dim Recorder             ' Recorder object
    Dim Path                 ' Directory of files to burn
    Dim Stream               ' Data stream for burning device

    Index = 0                ' Second drive on the system
    Path = "c:\ALASKA"      ' Files to transfer to disc

    ' Create a DiscMaster2 object to connect to optical drives.
    Dim g_DiscMaster
    Set g_DiscMaster = WScript.CreateObject("IMAPI2.MsftDiscMaster2")

    ' Create a DiscRecorder object for the specified burning device.
    Dim uniqueId
    set recorder = WScript.CreateObject("IMAPI2.MsftDiscRecorder2")
    uniqueId = g_DiscMaster.Item(index)

    recorder.InitializeDiscRecorder( uniqueId )

    ' Create an image stream for a specified directory.
    Dim FSI                  ' Disc file system
    Dim Dir                  ' Root directory of the disc file system
    Dim dataWriter

    ' Create a new file system image and retrieve root directory
    Set FSI = CreateObject("IMAPI2FS.MsftFileSystemImage")
    Set Dir = FSI.Root

    'Create the new disc format and set the recorder
    Set dataWriter = CreateObject ("IMAPI2.MsftDiscFormat2Data")
    dataWriter.recorder = Recorder
    dataWriter.ClientName = "IMAPIv2 TEST"

    FSI.ChooseImageDefaults(recorder)

    ' Add the directory and its contents to the file system
    Dir.AddTree Path, false

    ' Create an image from the file system
    Dim result
    Set result = FSI.CreateResultImage()
    Stream = result.ImageStream

    ' Write stream to disc using the specified recorder.
    WScript.Echo "Writing content to disc..."
    dataWriter.write(Stream)

    WScript.Echo "----- Finished writing content -----"
    Main = 0
End Function

und daraus habe ich das gemacht

Code: Alles auswählen

#include "Xbp.ch"
#include "Appevent.ch"
#define CRLF   CHR(13)+CHR(10)
#pragma library( "ascom10.lib" )

PROCEDURE APPSYS
RETURN

PROCEDURE MAIN
LOCAL lExit    := .F.
LOCAL nEvent, mp1, mp2, oXbp
LOCAL oDlg,oBtn
LOCAL aPos     := {  0,  0}
LOCAL aSize    := {300,200}

   oDlg  := XbpDialog():new(AppDeskTop(),,aPos,aSize)
   oDlg:title     := "Xbase++ ImAPI Burning CD R/W"
   oDlg:tasklist  := .T.
   oDlg:close     := {|| lExit := .T. }
   oDlg:create()
   CenterControl( oDlg  )

   oBtn  := XbpPushButton():new( oDlg:drawingArea ,, {10,10}, {100,30} )
   oBtn:caption   := "push me"
   oBtn:create()
   oBtn:activate  := {|| BurnImAPI(oDlg) }

   SetAppWindow(oDlg)
   SetAppFocus(oDlg)
   SetAppFocus(oBtn)

   nEvent := 0
   DO WHILE !lExit
      nEvent := AppEvent( @mp1, @mp2, @oXbp )
      DO CASE
         CASE nEvent = xbe_None

      OTHERWISE
         oXbp:handleEvent( nEvent, mp1, mp2 )
      ENDCASE
   ENDDO

RETURN

PROCEDURE BurnImAPI(oDlg)
LOCAL Index
LOCAL Recorder
LOCAL Path
LOCAL Stream
LOCAL g_DiscMaster
LOCAL uniqueId
LOCAL FSI
LOCAL TreeDir
LOCAL dataWriter
LOCAL result
LOCAL nStart
LOCAL nEnde

   Index := 0
   Path  := "c:\ALASKA"

   // {2735412E-7F64-5B0F-8F00-5D77AFBE261E}
*   g_DiscMaster := CreateObject("{2735412E-7F64-5B0F-8F00-5D77AFBE261E}")
*   g_DiscMaster := CreateObject("IMAPI2.MsftDiscMaster2.1")

*   g_DiscMaster := AutomationObject():create("{2735412E-7F64-5B0F-8F00-5D77AFBE261E}")
*   g_DiscMaster := AutomationObject():create("IMAPI2.MsftDiscMaster2.1")

    g_DiscMaster := XbpActiveXControl():new(oDlg,,{0,0},{1,1})
    g_DiscMaster:CLSID := "IMAPI2.MsftDiscMaster2.1"
*   g_DiscMaster:CLSID := "{2735412E-7F64-5B0F-8F00-5D77AFBE261E}"
    g_DiscMaster:create()

   IF NIL = g_DiscMaster
      msgbox("nix mit IMAPI2")
   ELSE

   // {2735412D-7F64-5B0F-8F00-5D77AFBE261E}
   Recorder     := CreateObject("IMAPI2.MsftDiscRecorder2")

   uniqueId     := g_DiscMaster:Item(index)

   Recorder:InitializeDiscRecorder( uniqueId )

   // {2C941FC5-975B-59BE-A960-9A2A262853A5}
   FSI := CreateObject("IMAPI2FS.MsftFileSystemImage")
   TreeDir := FSI:setProperty("Root")

   // {2735412A-7F64-5B0F-8F00-5D77AFBE261E}
   dataWriter := CreateObject ("IMAPI2.MsftDiscFormat2Data")
   dataWriter:recorder   := Recorder
   dataWriter:ClientName := "IMAPIv2 TEST"

   FSI:ChooseImageDefaults(Recorder)

   TreeDir:AddTree( Path, .F.)

   result := FSI:CreateResultImage()
   Stream := result:ImageStream

   Msgbox("Writing content to disc...")
   nStart := Seconds()

   dataWriter:write(Stream)

   nEnde := Seconds()
   Msgbox("----- Finished writing content -----"+CRLF+;
           LTRIM(STR( nEnde - nStart ))+" Seconds " )

   ENDIF
RETURN

ihr seht schon das ich eine Menge ausprobiert habe, aber ich komme schon beim ersten CreateObject() nicht weiter ... Xbase++ kann das nicht

... nun "erinnere" ich mich auch wieder warum Hannes meinte das es nicht so einfach sei : des ist nicht von iDispatch sondern von iUnknown ...

Frage : das es ja eine VbScript ist ... kann man den das VbScript als ActiveX "laden" ?

[Günter Beyes]

man kann!

Code: Alles auswählen

oShell := CreateObject("WScript.shell")
oShell:run( "test.vbs" )

test.vbs:
WScript.Echo "Hallo"
WScript.Quit 1

Gruß
Günter

[AUGE_OHR]

man kann!

hab ich mir doch gedacht.

Code: Alles auswählen

oShell := CreateObject("WScript.shell")
oShell:run( "test.vbs" )

hm ... ja ok ... aber das ist nicht ganz das was ich meinte

Code: Alles auswählen

// Idee ...

oShell := CreateObject("WScript.shell")
// umwandeln zum ActiveXObject() für evtl. Events
WScript :=  oShell:dynamicCast( ActiveXObject() )
WScript:Echo( "Hallo" )
WScript:Quit( 1 )

Grund : ich möchte nicht das jemand an den *.VBS rum fummelt ...

[Günter Beyes]

du könntest das .vbs als Ressource laden und erst vor Verwendung als Datei erzeugen.

Gruß
Günter

[AUGE_OHR]

du könntest das .vbs als Ressource laden und erst vor Verwendung als Datei erzeugen.

hm ... ja ... erst zur Laufzeit erzeugen das ginge ...

[AUGE_OHR]

hi,

ich habe mal das Yukon Project rausgeholt und probiere mich an Hannes CdBurner.
Das Demo scheint zu funktionieren ... folgendes aber nicht :

Code: Alles auswählen

METHOD YukonBurn:DriveErase()
LOCAL cBurner  := ::aBurner[ ::oComboBurn:XbpListBox:getData()[1] ]
...
::oCdBurner:selectDevice( cBurner )
::DefEvent()
...
IF ::lquick
   ::oCdBurner:eraseDisc(.F.)
ELSE
   ::oCdBurner:eraseDisc(.T.)
ENDIF

nError := ::oCdBurner:errorCode
IF nError == S_OK
   ::SayInfo(TIME()+" Erase Done")
ELSE
   ::SayInfo(TIME()+" "+::oCdBurner:errorMessage)
ENDIF

er gibt keinen Errorcode aber er macht "nichts" ?
und noch so ein Problem :

Code: Alles auswählen

METHOD YukonBurn:ShowCdInfo()
LOCAL cBurner := ::aBurner[ ::oComboBurn:XbpListBox:getData()[1] ]
...
::oCdBurner:selectDevice( cBurner )
::DefEvent()
...
::SayStatus("Media load ready ...",GRA_CLR_WHITE)

aType  := ::oCDBurner:queryMediaType()
iMax   := LEN(aType)
i := 1
FOR i := 1 TO iMax

   nMediaType := aType[i,1]
   nMediaFlag := aType[i,2]

   nError := 0
   DO WHILE .T.
      nError++
      IF nError > 100
         ::SayInfo("Error ... Timeout ...")
         EXIT
      ENDIF

      bSaveError := ErrorBlock()

      ErrorBlock( {|e| Break(e)} )
      BEGIN SEQUENCE

      SLEEP(10)
      DO CASE
         CASE nMediaType  <  0 ; ::SayInfo("Error: no device selected")
         CASE nMediaType ==  0 ; ::SayInfo("No CD present")
         CASE nMediaType ==  1 ; ::SayInfo("MEDIA_CDDA_CDROM")
         CASE nMediaType ==  2 ; ::SayInfo("MEDIA_CD_ROM_XA")
         CASE nMediaType ==  3 ; ::SayInfo("MEDIA_CD_I")
         CASE nMediaType ==  4 ; ::SayInfo("MEDIA_CD_EXTRA")
         CASE nMediaType ==  5 ; ::SayInfo("MEDIA_CD_OTHER")
         CASE nMediaType ==  6 ; ::SayInfo("MEDIA_SPECIAL")
      ENDCASE
      DO CASE
         CASE nMediaFlag  <  0 ; ::SayInfo("Error: no device selected")
         CASE nMediaFlag ==  0 ; ::SayInfo("No CD present")
         CASE nMediaFlag ==  1 ; ::SayInfo("MEDIA_BLANK")
         CASE nMediaFlag ==  2 ; ::SayInfo("MEDIA_RW")
         CASE nMediaFlag ==  4 ; ::SayInfo("MEDIA_WRITABLE")
      ENDCASE

      RECOVER USING oError
         LOOP
         ErrorBlock( bSaveError )
      END SEQUENCE
      ErrorBlock( bSaveError )
      EXIT
   ENDDO
NEXT

wenn ich keine Errorblock einfüge kommt ein Crash mit

oError:args :
-> VALTYPE: N VALUE: -1
-> VALTYPE: N VALUE: -1
oError:canDefault : N
oError:canRetry : N
oError:canSubstitute: J
oError:cargo : NIL
oError:description : Parameter hat falschen Typ
oError:filename :
oError:genCode : 2
oError:operation : <-1>==<-1>
oError:osCode : 0
oError:severity : 2
oError:subCode : 3
oError:subSystem : BASE
oError:thread : 1
oError:tries : 0

und mit Errorblock kommt nur mein "::SayInfo("Error ... Timeout ...")"

hat jemand Yukon am laufen ? sonst ein Tip ?