Login | Register
My pages Projects Community openCollabNet

Discussions > commits > svn commit: r38 - trunk

genelib
Discussion topic

Back to topic list

svn commit: r38 - trunk

Author lotec
Full name Jan Bogaerts
Date 2006-04-21 09:01:16 PDT
Message Author: LoTeC
Date: 2006-04-21 09:01:16-0700
New Revision: 38

Added:
   trunk/WShell32.gen
   trunk/com.gen
Modified:
   trunk/Dialogs.gen
   trunk/Threads.gen
   trunk/WKernel32.gen
   trunk/WindowsCommon.gen

Log:
-lots of small bugfixes
-added basic support for com (under windows) You should now be able to declare com interfaces, retrieve com objects, use com methods. Can not yet create com objects.

Modified: trunk/Dialogs.gen
Url: http://genelib.tigri​s.org/source/browse/​genelib/trunk/Dialog​s.gen?view=diff&​rev=38&p1=trunk/​Dialogs.gen&p2=t​runk/Dialogs.gen​&r1=37&r2=38
====================​====================​====================​==================
--- trunk/Dialogs.gen (original)
+++ trunk/Dialogs.gen 2006-04-21 09:01:16-0700
@@ -17,7 +17,7 @@
 //Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
 
 include widgets, ComDlg, memory, messagebox, string, basestore, windowscommon, wuser32, WGDI32, application, forms, system, actions,
- controls, resources;
+ controls, resources, wShell32, com;
 
 rename rModalResult = int;
 const
@@ -190,6 +190,60 @@
  exp Execute: bool override
 ;
 
+//-----------------​--------------------​--------------------​------------
+space sFolderBrowseDialog(​sBaseSysDialog) =
+ var Title: string //the caption of the window
+ DisplayName: string //the selected item, but as it was displayed, can be used when browsing for computer names or printers, when dir doesn't work
+// root: string //the root path of the dialog box, only this item and all of its sub items are visible in the dialog
+ fFlags: dword = 0 //internally used for the flags, use the properties instead
+ fDialogHandle: THandle = nil //the handle of the dialog as provided by the callback
+ prop BrowseForComputer: bool read exp GetBrowseForComputer: bool
+ write exp SetBrowseForComputer(aValue: bool)
+ BrowseForPrinter: bool read exp GetBrowseForPrinter: bool
+ write exp SetBrowseForPrinter(aValue: bool)
+ BrowseForURL: bool read exp GetBrowseForURL: bool
+ write exp SetBrowseForURL(aValue: bool)
+ IncludeFiles: bool read exp GetIncludeFiles: bool
+ write exp SetIncludeFiles(aValue: bool)
+ DontGoBelowDomain: bool read exp GetDontGoBelowDomain: bool
+ write exp SetDontGoBelowDomain(aValue: bool)
+ ShowEditBox: bool read exp GetShowEditBox: bool
+ write exp SetShowEditBox(aValue: bool)
+ NewDialogStyle: bool read exp GetNewDialogStyle: bool
+ write exp SetNewDialogStyle(aValue: bool)
+ NoNewFolderButton: bool read exp GetNoNewFolderButton: bool
+ write exp SetNoNewFolderButton(aValue: bool)
+ NoTranslateTargets: bool read exp GetNoTranslateTargets: bool
+ write exp SetNoTranslateTargets(aValue: bool)
+ ReturnFSAncestors: bool read exp GetReturnFSAncestors: bool
+ write exp SetReturnFSAncestors(aValue: bool)
+ ReturnOnlyFSDirs: bool read exp GetReturnOnlyFSDirs: bool
+ write exp SetReturnOnlyFSDirs(aValue: bool)
+ Shareable: bool read exp GetShareable: bool
+ write exp SetShareable(aValue: bool)
+ ShowStatusText: bool read exp GetShowStatusText: bool
+ write exp SetShowStatusText(aValue: bool)
+ ShowUsageHint: bool read exp GetShowUsageHint: bool
+ write exp SetUsageHint(aValue: bool)
+ Validate: bool read exp GetValidate: bool
+ write exp SetValidate(aValue: bool)
+ StatusText: string read var fStatusText: string //displays a statustext on dialog
+ write exp SetStatusText(aValue: string&)
+ OkEnabled: bool read var fOkEnabled: bool = true //is ok button enabled
+ write exp SetOkEnabled(aValue: bool)
+ OkText: string read var fOkText: string.init('Ok') //text on ok button
+ write exp SetOkText(aValue: string&)
+ Dir: string read var fDir: string //the selected folder, set before execute for default value, doesn't work for computers or printers
+ write exp SetDir(aValue: string&)
+ exp Execute: bool override
+ CallbackExp(aHandle: thandle, umsg: dword, lparam: int, lpdata: int): int static //callback for the dialog
+ CallbackHandler(aHandle: THandle, aMsg: dword, lParam: int) //internally handles the callback events
+ InitDialog virtual //called when dialog is initially shown, called by the callback
+ SelChanged(aPidl: ITEMIDLIST^) virtual =; //called when selection is changed, reimplement this if you want custom actions
+ ValidateFailed(aName: TCHAR^) virtual //called when validation of editbox content failed (doesn't point to dir)
+ iUnkownInterfaceFound(aInt: pointer) virtual =; //called when an iUnkown interface is passed to the callback
+;
+
 //------------------​--------------------​--------------------​--------------------​--------------------​-
 exp sBaseSysDialog.HandleError: bool
 =
@@ -706,4 +760,258 @@
    iVal.lpLogFont = @Font
    iVal.Flags = CF_FORCEFONTEXIST | CF_INITTOLOGFONTSTRUCT | CF_SCREENFONTS
    return(Comdlg32.Choo​seFont(@iVal))
-;
\ No newline at end of file
+;
+
+
+//-----------------​--------------------​--------------------​------------
+exp sFolderBrowseDialog.Execute: bool
+=
+ iInfo: BROWSEINFO
+ iDisplayName: TCHAR@MAX_PATH
+ ipiid: ITEMIDLIST^ = nil
+ iPath: TCHAR@MAX_PATH
+ iPathStr: string
+
+ iInfo.lpszTitle = title.c_str
+ iInfo.pszDisplayName = iDisplayName
+ iInfo.lpszTitle = Title.C_Str()
+ iInfo.ulFlags = fFlags
+ iInfo.lpfn = @CallbackExp
+ iInfo.lParam = int(self)
+
+ com.CoInitialize(nil)
+ try
+ iPiid = Shell32.SHBrowseForF​older(@iInfo)
+ fDialogHandle = nil //the dialog is no longer visible
+ [<-iPiid <> nil->
+ try
+ [<-Shell32.SHGetP​athFromIDList(iPiid,​ iPath) == false-> return(false)]
+ iPathStr = iPath
+ Dir = iPathStr
+ DisplayName = iDisplayName
+ return(true)
+ finally com.CoTaskMemFree(iPiid)
+ <-->
+ return(false)
+ ]
+ finally com.CoUninitialize
+;
+
+exp sFolderBrowseDialog.​CallbackExp(aHandle:​ thandle, umsg: dword, lparam: int, lpdata: int): int
+=
+ iSelf: sFolderBrowseDialog^
+
+ iSelf = sFolderBrowseDialog^(lpData)
+ iSelf.CallbackHandler(aHandle, umsg, lParam)
+ return(0)
+;
+
+exp sFolderBrowseDialog.​CallbackHandler(aHan​dle: THandle, aMsg: dword, lParam: int)
+=
+ FDialogHandle = aHandle
+ [aMsg
+ <-BFFM_INITIALIZED-> InitDialog
+ <-BFFM_SELCHANGED-> SelChanged(ITEMIDLIST^(lParam))
+ <-BFFM_VALIDATEFAILED-> ValidateFailed(TCHAR^(lParam))
+ <-BFFM_IUNKNOWN-> iUnkownInterfaceFoun​d(pointer(lparam))
+ ]
+;
+
+exp sFolderBrowseDialog.InitDialog
+=
+ //assign all the props to themselves so that the sendmessages are called
+ StatusText = StatusText
+ OkEnabled = OkEnabled
+ [<-OkText <> 'Ok'-> OkText = OkText]
+ [<-Dir.NrRecords > 0-> Dir = Dir]
+;
+
+exp sFolderBrowseDialog.​ValidateFailed(aName​: TCHAR^)
+=
+ iMsg: string
+ iMsg = aName
+ iMsg += ' is an invalid folder'
+ sMessageBox.ShowMessage(iMsg)
+;
+
+exp sFolderBrowseDialog.​SetStatusText(aValue​: string&)
+=
+ fStatusText = aValue
+ [<-fDialogHandle <> nil->
+ User32.SendMessage(f​DialogHandle, BFFM_SETSTATUSTEXT, 0, int(fStatusText.c_str))
+ ]
+;
+
+exp sFolderBrowseDialog.​SetOkEnabled(aValue:​ bool)
+=
+ fOkEnabled = aValue
+ [<-fDialogHandle <> nil->
+ User32.SendMessage(f​DialogHandle, BFFM_ENABLEOK, 0, aValue)
+ ]
+;
+
+exp sFolderBrowseDialog.​SetOkText(aValue: string&)
+=
+ fOkText = aValue
+ [<-fDialogHandle <> nil->
+ User32.SendMessage(f​DialogHandle, BFFM_SETOKTEXT, int(fOkText.c_str), 0)
+ ]
+;
+
+exp sFolderBrowseDialog.​SetDir(aValue: string&)
+=
+ fDir = aValue
+ [<-fDialogHandle <> nil->
+ User32.SendMessage(f​DialogHandle, BFFM_SETSELECTION, int(fDir.c_str), 0)
+ ]
+;
+
+exp sFolderBrowseDialog.​GetBrowseForComputer​: bool
+=
+ return(bool(fFlags & BIF_BROWSEFORCOMPUTER))
+;
+
+exp sFolderBrowseDialog.​SetBrowseForComputer​(aValue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_BROWSEFORCOMPUTER]
+;
+
+exp sFolderBrowseDialog.​GetBrowseForPrinter:​ bool
+=
+ return(bool(fFlags & BIF_BROWSEFORPRINTER))
+;
+
+exp sFolderBrowseDialog.​SetBrowseForPrinter(​aValue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_BROWSEFORPRINTER]
+;
+
+exp sFolderBrowseDialog.​GetIncludeFiles: bool
+=
+ return(bool(fFlags & BIF_BROWSEINCLUDEFILES))
+;
+
+exp sFolderBrowseDialog.​SetIncludeFiles(aVal​ue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_BROWSEINCLUDEFILES]
+;
+
+exp sFolderBrowseDialog.​GetDontGoBelowDomain​: bool
+=
+ return(bool(fFlags & BIF_DONTGOBELOWDOMAIN))
+;
+
+exp sFolderBrowseDialog.​SetDontGoBelowDomain​(aValue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_DONTGOBELOWDOMAIN]
+;
+
+exp sFolderBrowseDialog.​GetShowEditBox: bool
+=
+ return(bool(fFlags & BIF_EDITBOX))
+;
+
+exp sFolderBrowseDialog.​SetShowEditBox(aValu​e: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_EDITBOX]
+;
+
+exp sFolderBrowseDialog.​GetNewDialogStyle: bool
+=
+ return(bool(fFlags & BIF_NEWDIALOGSTYLE))
+;
+
+exp sFolderBrowseDialog.​SetNewDialogStyle(aV​alue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_NEWDIALOGSTYLE]
+;
+
+exp sFolderBrowseDialog.​GetNoNewFolderButton​: bool
+=
+ return(bool(fFlags & BIF_NONEWFOLDERBUTTON))
+;
+
+exp sFolderBrowseDialog.​SetNoNewFolderButton​(aValue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_NONEWFOLDERBUTTON]
+;
+
+exp sFolderBrowseDialog.​GetNoTranslateTarget​s: bool
+=
+ return(bool(fFlags & BIF_NOTRANSLATETARGETS))
+;
+
+exp sFolderBrowseDialog.​SetNoTranslateTarget​s(aValue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_NOTRANSLATETARGETS]
+;
+
+exp sFolderBrowseDialog.​GetReturnFSAncestors​: bool
+=
+ return(bool(fFlags & BIF_RETURNFSANCESTORS))
+;
+
+exp sFolderBrowseDialog.​SetReturnFSAncestors​(aValue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_RETURNFSANCESTORS]
+;
+
+exp sFolderBrowseDialog.​GetReturnOnlyFSDirs:​ bool
+=
+ return(bool(fFlags & BIF_RETURNONLYFSDIRS))
+;
+
+exp sFolderBrowseDialog.​SetReturnOnlyFSDirs(​aValue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_RETURNONLYFSDIRS]
+;
+
+exp sFolderBrowseDialog.​GetShareable: bool
+=
+ return(bool(fFlags & BIF_SHAREABLE))
+;
+
+exp sFolderBrowseDialog.​SetShareable(aValue:​ bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_SHAREABLE]
+;
+
+exp sFolderBrowseDialog.​GetShowStatusText: bool
+=
+ return(bool(fFlags & BIF_STATUSTEXT))
+;
+
+exp sFolderBrowseDialog.​SetShowStatusText(aV​alue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_STATUSTEXT]
+;
+
+exp sFolderBrowseDialog.​GetShowUsageHint: bool
+=
+ return(bool(fFlags & BIF_UAHINT))
+;
+
+exp sFolderBrowseDialog.​SetUsageHint(aValue:​ bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_UAHINT]
+;
+
+exp sFolderBrowseDialog.​GetValidate: bool
+=
+ return(bool(fFlags & BIF_VALIDATE))
+;
+
+exp sFolderBrowseDialog.​SetValidate(aValue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_VALIDATE]
+;
+
+exp sFolderBrowseDialog.​GetBrowseForURL: bool
+=
+ return(bool(fFlags & BIF_BROWSEINCLUDEURLS))
+;
+
+exp sFolderBrowseDialog.​SetBrowseForURL(aVal​ue: bool)
+=
+ [<-BrowseForComputer <> aValue-> fFlags = fFlags ~ BIF_BROWSEINCLUDEURLS]
+;

Modified: trunk/Threads.gen
Url: http://genelib.tigri​s.org/source/browse/​genelib/trunk/Thread​s.gen?view=diff&​rev=38&p1=trunk/​Threads.gen&p2=t​runk/Threads.gen​&r1=37&r2=38
====================​====================​====================​==================
--- trunk/Threads.gen (original)
+++ trunk/Threads.gen 2006-04-21 09:01:16-0700
@@ -77,6 +77,7 @@
              #iTempName = SyncOutEl.Name
              #iTempName = '_sGenerated' + iTempName + 'ThreadSyncOutVal'
              space #(iTempName) (sThreadSyncOutVal) =
+ var
               #{#<-SyncOutEl.pars \ syncOutVar->
                    #(syncOutVar)
               #}

Modified: trunk/WKernel32.gen
Url: http://genelib.tigri​s.org/source/browse/​genelib/trunk/WKerne​l32.gen?view=diff​&rev=38&p1=trun​k/WKernel32.gen&​p2=trunk/WKernel32.g​en&r1=37&r2=​38
====================​====================​====================​==================
--- trunk/WKernel32.gen (original)
+++ trunk/WKernel32.gen 2006-04-21 09:01:16-0700
@@ -98,7 +98,6 @@
   INVALID_SET_FILE_POINTER = -1
   INVALID_FILE_ATTRIBUTES = -1
   
- MAX_PATH = 260
   
  FILE_SHARE_READ = 0x00000001
  FILE_SHARE_WRITE = 0x00000002

Added: trunk/WShell32.gen
Url: http://genelib.tigri​s.org/source/browse/​genelib/trunk/WShell​32.gen?view=auto​&rev=38
====================​====================​====================​==================
--- (empty file)
+++ trunk/WShell32.gen 2006-04-21 09:01:16-0700
@@ -0,0 +1,117 @@
+//copyright LoTeC (Jan Bogaerts) 2006
+
+//This unit is part of the Gene standarad library
+
+//This program is free software; you can redistribute it and/or modify
+//it under the terms of the Lesser GNU General Public License as published by
+//the Free Software Foundation; either version 2.1 of the License, or
+//(at your option) any later version.
+
+//This program is distributed in the hope that it will be useful,
+//but WITHOUT ANY WARRANTY; without even the implied warranty of
+//MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+//Lesser GNU General Public License for more details.
+
+//You should have received a copy of the Lesser GNU General Public License
+//along with this program; if not, write to the Free Software
+//Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+include windowsCommon, com, wUser32;
+
+struct SHITEMID =
+ var cb: word
+ abID: byte@1
+;
+
+struct ITEMIDLIST =
+ var mkid: SHITEMID
+;
+
+rename BFFCALLBACK = exp(aHandle: thandle, umsg: dword, lparam: int, lpdata: int): int static;
+
+struct BROWSEINFOA =
+ var hwndOwner: HWND = nil
+ pidlRoot: ITEMIDLIST^ = nil
+ pszDisplayName: char^ = nil // Return display name of item selected.
+ lpszTitle: char^ = nil // text to go in the banner over the tree.
+ ulFlags: dword = 0 // Flags that control the return stuff
+ lpfn: BFFCALLBACK = nil
+ lParam: int = 0 // extra info that's passed back in callbacks
+ iImage: int = 0 // output var: where to return the Image index.
+;
+
+struct BROWSEINFOW =
+ var hwndOwner: HWND = nil
+ pidlRoot: ITEMIDLIST^ = nil
+ pszDisplayName: short^ = nil // Return display name of item selected.
+ lpszTitle: short^ = nil // text to go in the banner over the tree.
+ ulFlags: dword = 0 // Flags that control the return stuff
+ lpfn: BFFCALLBACK = nil
+ lParam: int = 0 // extra info that's passed back in callbacks
+ iImage: int =0 // output var: where to return the Image index.
+;
+
+#[#<-UniCode == false->
+ rename BROWSEINFO = BROWSEINFOA;
+ #<-->
+ rename BROWSEINFO = BROWSEINFOW;
+#]
+
+
+lib lShell32 =
+ exp
+ #[#<-UniCode == false->
+ SHBrowseForFolder(lpbi: BROWSEINFOA^): ITEMIDLIST^ stdcall extern 'SHBrowseForFolderA'
+ SHGetPathFromIDList(pidl: ITEMIDLIST^, pszPath: char^): bool stdcall extern 'SHGetPathFromIDListA'
+ #<-->
+ SHBrowseForFolder(lpbi: BROWSINFOW^): ITEMIDLIST^ stdcall extern 'SHBrowseForFolderW'
+ SHGetPathFromIDList(pidl: ITEMIDLIST^, pszPath: short^): bool stdcall extern 'SHGetPathFromIDListW'
+ #]
+;
+
+var Shell32: lShell32;
+
+// Browsing for directory.
+const
+ BIF_RETURNONLYFSDIRS = 0x0001
+ BIF_DONTGOBELOWDOMAIN = 0x0002
+ BIF_STATUSTEXT = 0x0004
+ BIF_RETURNFSANCESTORS = 0x0008
+ BIF_EDITBOX = 0x0010
+ BIF_VALIDATE = 0x0020
+ BIF_NEWDIALOGSTYLE = 0x0040
+ BIF_USENEWUI = BIF_NEWDIALOGSTYLE | BIF_EDITBOX
+ BIF_BROWSEINCLUDEURLS = 0x0080
+ BIF_UAHINT = 0x0100
+ BIF_NONEWFOLDERBUTTON = 0x0200
+ BIF_NOTRANSLATETARGETS = 0x0400
+ BIF_BROWSEFORCOMPUTER = 0x1000
+ BIF_BROWSEFORPRINTER = 0x2000
+ BIF_BROWSEINCLUDEFILES = 0x4000
+ BIF_SHAREABLE = 0x8000
+// message from browser
+ BFFM_INITIALIZED = 1
+ BFFM_SELCHANGED = 2
+ BFFM_VALIDATEFAILEDA = 3
+ BFFM_VALIDATEFAILEDW = 4
+ BFFM_IUNKNOWN = 5
+
+// messages to browser
+ BFFM_SETSTATUSTEXTA = (WM_USER + 100)
+ BFFM_ENABLEOK = (WM_USER + 101)
+ BFFM_SETSELECTIONA = (WM_USER + 102)
+ BFFM_SETSELECTIONW = (WM_USER + 103)
+ BFFM_SETSTATUSTEXTW = (WM_USER + 104)
+ BFFM_SETOKTEXT = (WM_USER + 105) // Unicode only
+ BFFM_SETEXPANDED = (WM_USER + 106) // Unicode only
+
+ #[#<-UniCode == false->
+ BFFM_SETSTATUSTEXT = BFFM_SETSTATUSTEXTA
+ BFFM_SETSELECTION = BFFM_SETSELECTIONA
+ BFFM_VALIDATEFAILED = BFFM_VALIDATEFAILEDA
+ #<-->
+ BFFM_SETSTATUSTEXT = BFFM_SETSTATUSTEXTW
+ BFFM_SETSELECTION = BFFM_SETSELECTIONW
+ BFFM_VALIDATEFAILED = BFFM_VALIDATEFAILEDW
+ #]
+;
\ No newline at end of file

Modified: trunk/WindowsCommon.gen
Url: http://genelib.tigri​s.org/source/browse/​genelib/trunk/Window​sCommon.gen?view=dif​f&rev=38&p1=​trunk/WindowsCommon.​gen&p2=trunk/Win​dowsCommon.gen&r​1=37&r2=38
====================​====================​====================​==================
--- trunk/WindowsCommon.gen (original)
+++ trunk/WindowsCommon.gen 2006-04-21 09:01:16-0700
@@ -46,6 +46,7 @@
 rename HMonitor = THandle;
 rename HWinEventHook = THandle;
 rename HCursor = THandle;
+rename HRESULt = int;
 
 rename FarProc = pointer;
 rename widechar = word;
@@ -80,4 +81,5 @@
  _MAX_DIR = 256
  _MAX_FNAME = 256
  _MAX_EXT = 256
+ MAX_PATH = _MAX_PATH
 ;
\ No newline at end of file

Added: trunk/com.gen
Url: http://genelib.tigri​s.org/source/browse/​genelib/trunk/com.ge​n?view=auto&rev=​38
====================​====================​====================​==================
--- (empty file)
+++ trunk/com.gen 2006-04-21 09:01:16-0700
@@ -0,0 +1,121 @@
+//copyright LoTeC (Jan Bogaerts) 2006
+
+//This unit is part of the Gene standarad library
+
+//This program is free software; you can redistribute it and/or modify
+//it under the terms of the Lesser GNU General Public License as published by
+//the Free Software Foundation; either version 2.1 of the License, or
+//(at your option) any later version.
+
+//This program is distributed in the hope that it will be useful,
+//but WITHOUT ANY WARRANTY; without even the implied warranty of
+//MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+//Lesser GNU General Public License for more details.
+
+//You should have received a copy of the Lesser GNU General Public License
+//along with this program; if not, write to the Free Software
+//Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+include windowscommon;
+
+
+auto ComInterface(struct) =
+ chapter method: explist
+ is |<
+ #addwarning('still need to check for os type and act different accordingly')
+ //first check that there aren't any vars defined, if that is, it's illegal cause a com interface can't have data
+ #[#<-self.vars.nrrecords > 0->
+ #adderror('a com interface can|'t have variables')
+ #]
+ #iComName: Identifier
+ #iComName = self.name
+ #iComName = '_ComInterfaceGenerated' + iComName
+ //for each method, we need to declare a function pointer
+ #iExpName: Identifier
+ #iMethod: self.method.entity
+ #iPar: iMethod.pars.entity
+ #{#<-self.method \ iMethod->
+ #iExpName = iMethod.name
+ #iExpName = 'r' + icomName + iExpName
+ rename #(iExpName) = exp(aSelf: pointer
+ #{#<-iMethod.Pars \ iPar->, #(iPar.name): #(iPar.TypeDecl) #} ) #[#<-imethod.resu​ltvalue.nrrecords > 0->: #(imethod.resultvalue) #] stdcall static ;
+ #}
+ //next, we need to define the function table
+ #iFuncTable: Identifier
+ #iFuncTable = self.name
+ #iFuncTable = '_ComFunctiontable' + iFuncTable
+ struct #(iFuncTable) =
+ var
+ #{#<-self.method \ iMethod->
+ #iExpName = iMethod.name
+ #iExpName = icomName + iExpName
+ #(iExpName):
+ #iExpName = 'r' + iExpName
+ #(iExpName)
+ #}
+ ;
+ //the struct that is used as the data object
+ struct #(iComName) =
+ var _vTable: #(iFuncTable)
+ exp
+ #{#<-self.method \ iMethod->
+ #(iMethod.name) ( #(iMethod.Pars) ) #[#<-imethod.resu​ltvalue.nrrecords > 0->: #(imethod.resultvalue) #] inline =
+ #iExpName = iMethod.name
+ #iExpName = icomName + iExpName
+ return(_vtable. #(iExpName) (self #{#<-iMethod.pars \ iPar-> , #(iPar.Name) #} ) )
+ ;
+ #}
+ ;
+ //and a rename to a pointer of the struct, cause a com interface is always a pointer object and we must declare it as such
+ rename #(self.Name) = #(iComName)^;
+ >|
+;
+
+struct GUID =
+ var Data1: dword
+ Data2: word
+ Data3: word
+ Data4: byte@4
+;
+
+rename CLSID = GUID;
+rename REFCLSID = CLSID^;
+rename IID = GUID;
+rename REFIID = GUID^;
+
+struct COSERVERINFO =
+ var dwReserved1: dword
+ pwszName: short^
+ pAuthInfo: pointer
+ dwReserved2: dword
+;
+
+lib lOle32 =
+ exp CoInitialize(aReserved: pointer): HRESULT stdcall extern 'CoInitialize'
+ CoUninitialize stdcall extern 'CoUninitialize'
+ CoCreateInstance(rclsid: REFCLSID, pUnkOuter: pointer, dwClsContext: dword, riid: REFIID, ppv: pointer^): HRESULT stdcall extern 'CoCreateInstance'
+ CoGetClassObject(rclsid: REFCLSID, dwClsContext: dword, pServerInfo: COSERVERINFO, riid: REFIID, ppv: pointer^): HRESULT stdcall extern 'CoGetClassObject'
+ CoTaskMemFree(pv: pointer) stdcall extern 'CoTaskMemFree'
+ CoTaskMemAlloc(aSize: dword): pointer stdcall extern 'CoTaskMemAlloc'
+;
+
+var Com: lOle32;
+
+#toggleGenerator(true)
+
+ComInterface iUnknown =
+ method QueryInterface(riid: REFIID, ppv: pointer^): HRESULT
+ AddRef: dword
+ Release: dword
+;
+
+#toggleGenerator(false)
+
+ComInterface iMalloc(iUnknown) =
+ method Alloc(aSize: dword): pointer
+ Realloc(aVal: pointer, aSize: dword): pointer
+ Free(aVal: pointer)
+ GetSize(aVal: pointer): dword
+ DidAlloc(aVal: pointer): int
+ HeapMinimize
+;
\ No newline at end of file

« Previous message in topic | 1 of 1 | Next message in topic »

Messages

Show all messages in topic

svn commit: r38 - trunk lotec Jan Bogaerts 2006-04-21 09:01:16 PDT
Messages per page: