XProfan

+-----------------------------------------------------------------------+
| olefile.prf - Dateien öffnen und schließen mit OLE                    |
| Autor: Sebastian König                                                |
| email: feedback@sekoenig.de                                           |
| Homepage: http://www.sekoenig.de                                      |
| Copyright ©2001 Sebastian König                                       |
|                                                                       |
| Dieser Quellcode zeigt, wie man mit OLE und Profan² ein Word-Dokument |
| zum Bearbeiten öffnet.                                                |
|                                                                       |
|                                                                       |
| WICHTIG: Dieser Quellcode funktioniert erst ab Profan 7.0 und setzt   |
|          voraus, dass Microsoft® Word installiert ist.                |
|                                                                       |
| TIP(P):  Diese Methode funktioniert nicht nur mit Word-Dokumenten.    |
|          Wenn man die Dateimaske zum Beispiel in *.bmp ändert, wird   |
|          automatisch Paint (oder ein anderes Zeichenprogramm)         |
|          geöffnet.                                                    |
|                                                                       |
+-----------------------------------------------------------------------+
---Prozeduren

proc Release

    parameters obj&
    declare vptr&
    let vptr& = @long(obj&,0)
    return Call(@long(vptr&,8),obj&)

endproc

+++
---Benötigte (COM/OLE)-API-Funktionen:
DEF OleInitialize(1) !"OLE32","OleInitialize"
DEF OleUninitialize(0) !"OLE32","OleUninitialize"
DEF IIDFromString(2) !"OLE32","IIDFromString"
DEF CoTaskMemAlloc(1) !"OLE32","CoTaskMemAlloc"
DEF CoTaskMemFree(1) !"OLE32","CoTaskMemFree"
DEF CreateILockBytesOnHGlobal(3) !"OLE32","CreateILockBytesOnHGlobal"
DEF StgCreateDocfileOnILockBytes(4) !"OLE32","StgCreateDocfileOnILockBytes"
DEF OleCreateFromFile(8) !"OLE32","OleCreateFromFile"
DEF MultiByteToWideChar(6) !"KERNEL32","MultiByteToWideChar"
DEF Sleep(1) !"KERNEL32","Sleep"
---Variablen deklarieren:
declare ILockBytes&,IStorage&,IOleClientSite&,IRichEditOle&,MSWord&,IUnknown&
declare vp_MSWord&,vp_RTFOle&
declare CLSID_MSWord&,IID_IOleObject&,IID_IOleClientSite&,IID_IUnknown&
declare clsid$,iid$,olestr&
declare file$,file&
declare FORMATETC#,RECT#,MSG#
declare count&
---Speicher allokieren:
let ILockBytes& = CoTaskMemAlloc(4)
let IStorage& = CoTaskMemAlloc(4)
let MSWord& = CoTaskMemAlloc(4)
let IID_IOleObject& = CoTaskMemAlloc(16)
let olestr& = CoTaskMemAlloc(256)
let file& = CoTaskMemAlloc(1024)
dim FORMATETC#,20
---Neues Fenster erstellen:
windowtitle "OLE mit Profan²"
window 100,100-640,480
---OLE initialisieren:
print "OleInitialize:",OleInitialize(0),"
"
---Storage-Objekt erstellen:
print "CreateILockBytesOnHGlobal:",CreateILockBytesOnHGlobal(0,1,Addr(ILockBytes&)),"
"
print "StgCreateDocfileOnILockBytes:",StgCreateDocfileOnILockBytes(ILockBytes&,$1012,0,Addr(IStorage&)),"
"
---MSWord-Objekt erstellen:
--IID für IOleObject aus String bilden:
let iid$ = "{00000112-0000-0000-C000-000000000046}"
MultiByteToWideChar(0,0,Addr(iid$),Len(iid$),olestr&,261),"
"
print "IIDFromString:",IIDFromString(olestr&,IID_IOleObject&),"
"
--Datei wählen
let file$ = LoadFile$("Word-Dokumente","*.doc")
MultiByteToWideChar(0,0,Addr(file$),Len(file$),file&,261),"
"
--FORMATETC# füllen...
long FORMATETC#,0  = 0
long FORMATETC#,4  = 0
long FORMATETC#,8  = 1 DVASPECT_CONTENT
long FORMATETC#,12 = 0
long FORMATETC#,16 = 0 TYMED_NULL
--Objekt erstellen:
print "OleCreateFromFile:",OleCreateFromFile(0,file&,IID_IOleObject&,0,FORMATETC#,0,IStorage&,Addr(MSWord&)),"
"
--vptr ermitteln:
let vp_MSWord& = @long(MSWord&,0)
MessageBox("Die Datei wird nun geöffnet und in ca. 5 Sekunden
automatisch wieder geschlossen.","Meldung",64)
---Objekt zum Bearbeiten öffnen:
print "MSWord&->DoVerb:",Call(@long(vp_MSWord&,44),MSWord&,-1,0,0,0,%hwnd,0)
---5 Sekunden warten, ohne den Prozess zu blockieren:
let count& = @add(&GetTickCount,5000)

while @lt(&GetTickCount,count&)

    Sleep(0)

wend

---Objekt wieder schließen:
print "MSWord&->Close:",Call(@long(vp_MSWord&,24),MSWord&,0)
print " "
print "> Taste oder Mausklick zum Beenden! <"
waitinput
---Aufräumarbeiten:
Release MSWord&
Release IStorage&
Release ILockBytes&
CoTaskMemFree(ILockBytes&)
CoTaskMemFree(IStorage&)
CoTaskMemFree(MSWord&)
CoTaskMemFree(CLSID_MSWord&)
CoTaskMemFree(IID_IOleObject&)
CoTaskMemFree(olestr&)
dispose FORMATETC#
OleUninitialize()
---Ende:
end