Excel Disphelper help

External libraries (GTK, GSL, SDL, Allegro, OpenGL, etc) questions.
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Postby Zippy » Mar 22, 2010 21:09

@phishguy

Google AccessVBOM
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » Mar 23, 2010 14:19

That lloks like a method that would work. However, you need to know what version of Office is running in order to set the registry properly.

I have mixed feelings about MS security. It is good in that it attempts to protect you from viruses and tojans. On the other hand, if you are a programmer, it is a pain in the ass.
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » Mar 23, 2010 17:59

Zippy,
I hacked together a function that modifies the registry values for the Excel macro security. It can also be used for other MS apps. I got the example from doing a search based on AccessVBOM as you suggested. It took me awhile to get the program to compile without complaining about passing different pointer types. Anyways, it seems to work. It would need modifications for Office 2007. I am unable modify and test for Office 2007 since I don't have access to it and I don't know what other nuances there may be.

Code: Select all

'Purpose     :  Enables or disables the macro virus alert by altering the security level in the registry.
'Inputs      :  lSecurityLevel              1, sets security to "Low" (disable virus alerts)
'                                           2, sets security to "Medium"
'                                           3, sets security to "High"
'                                           4, sets security to "High" and disables access to VB Object Model
'               AppType                     The application to set the security for.
'               OfficeVersion               The installed version of Office.
'Outputs     :  Returns True on success
'Notes       :  Requires Excel 2000
#include once "windows.bi"

Function OfficeMacroSecurity(lSecurityLevel As Long, AppType As string, OfficeVersion As string) As integer
    Dim sData As String, lRet As hkey, sAppKey As String
    Const csKeyGen As String = "Software\Microsoft\Office\"
    Const csKeyVBOM As String = "AccessVBOM", csKey  As String = "Level"
   
    If lSecurityLevel <= 4 And lSecurityLevel > 0 Then
        On Error GoTo ErrFailed
        Select Case ucase(OfficeVersion)
        Case "OFFICE2000"
            sAppKey = csKeyGen & "9.0\"
        Case "OFFICEXP"
            sAppKey = csKeyGen & "10.0\"
        Case "OFFICE2003"
            sAppKey = csKeyGen & "11.0\"
        Case Else
            Print "Invalid version"
           
            OfficeMacroSecurity = False
            Exit Function
        End Select
       
        Select Case ucase(AppType)
        Case "EXCEL"
            sAppKey = sAppKey & "Excel\Security"
        Case "OUTLOOK"
            sAppKey = sAppKey & "Outlook\Security"
        Case "POWERPOINT"
            sAppKey =  sAppKey & "PowerPoint\Security"
        Case "PUBLISHER"
            sAppKey = sAppKey & "Publisher\Security"
        Case "WORD"
            sAppKey = sAppKey & "Word\Security"
        Case Else
           Print "Invalid application"
           
            OfficeMacroSecurity = False
            Exit Function
        End Select
       

        RegCreateKey HKEY_CURRENT_USER, sAppKey, @lRet
        'Set the registry key macro security reg key
        dim level as long = 1
        If lSecurityLevel = 4 Then
            'Set to high
             level = 3
            RegSetValueEx lRet, csKey, 0, REG_DWORD, cast(LPSTR,@level), sizeof(dword)
        Else
            'Set to the specified level
            level = lsecuritylevel
            RegSetValueEx lRet, csKey, 0, REG_DWORD, cast(LPSTR,@Level), sizeof(dword)
        End If
               
                 
        If lSecurityLevel < 4 Then
            'Enable access to VB Object Model
            level = 1
            RegSetValueEx lRet, csKeyVBOM, 0, REG_DWORD, cast(LPSTR,@level), sizeof(dword)
        Else
            level = 0
            'Disable access to VB Object Model
            RegSetValueEx lRet, csKeyVBOM, 0, REG_DWORD, cast(LPSTR,@level), sizeof(dword)
        End If
       
        RegCloseKey lRet
       
        OfficeMacroSecurity = True
    Else
      Print "Invalid Security Level"
     
    End If
   
    Exit Function
   
ErrFailed:
   Print "Error"
    OfficeMacroSecurity = False
End Function


print officemacrosecurity(1,"Excel","Office2003")
sleep
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Postby Zippy » Mar 23, 2010 21:11

Nice code!

Here's the version:

Code: Select all

'Excel Version
#include once "windows.bi"
#define UNICODE
#include once "disphelper\disphelper.bi"
#undef UNICODE
'
dim xlApp as IDispatch ptr
dhInitialize(TRUE)
dhToggleExceptions(TRUE)
dhCreateObject("Excel.Application",NULL,@xlApp)
dhPutValue(xlApp,".DisplayFullScreen = %b",FALSE)
dhCallMethod(xlApp,".Workbooks.Add")
'dhPutValue(xlApp,".Visible = %b",TRUE)
'
dim as HRESULT hres
dim as zstring ptr TVersion
'
hres=dhgetvalue("%s",@TVersion,xlApp,".Version")
print *TVersion
'
hres=dhcallmethod(xlapp,".Quit")
SAFE_FREE_STRING(TVersion)
SAFE_RELEASE(xlApp)
dhUninitialize(TRUE)
'
print
print "Sleeping.."
sleep


Probably risky to include registry-modding code in xlhelper. Maybe.. Insert the function call but keep the function as a separate include requiring deliberate end-user inclusion?

When Windows had no security model (WIN9X) people screamed (me!). When security was added people screamed. When UAC was added people had hysterical fits. Can't please everyone all the time..
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » Mar 23, 2010 22:47

Zippy,
I had already written a function to get the excel version today. The only issue with doing this is that you need to open Excel, get the version, close Excel, set the macro security, and the reopen Excel. It's not really a problem. But it takes a little bit of time.

On another note, I noticed that you used the command SAFE_FREE_STRING. I assume that it frees up the allocated string space. I hadn't used this before in any of my other functions. How necessary is this?
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Postby Zippy » Mar 24, 2010 0:09

From: http://disphelper.sourceforge.net/readme.htm

disphelper readme wrote:Note 1: When a string is returned using dhGetValue() it should be freed using dhFreeString().


I'm not consistent with (in using) this. It's probably a good idea as disphelper/COM is allocating the memory for the string, fb has no way to know this to release it at function exit (fb just kills the ptr). Pedantic. And immaterial unless the function is called a gazillion times.

How are you determining the Office version if not directly from an initialized app? I think I read that the registry version key (i.e., "12.0" for Excel 2007) doesn't exist prior to version "10.n"' (Office 2002). [Not tested] Is it necessary to change the macro registry key before creating the xlapp? - I expect so, but am asking..

Note that Office 2010 skips version "13.n", it becomes "14.n". Superstitions.. And no doubt more weird $%#@ to deal with - hopefully all backwards compatible (!).
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Postby Zippy » Mar 26, 2010 1:05

@phish re: getting Excel version

I don't know if this code is any faster than opening Excel via disphelper; but I believe that it, albeit LONG, is more reliable than guessing at M$'s registry keys:

Code: Select all

'Get file version info, Windows only
#include once "windows.bi"
#include once "win\shlwapi.bi"
'
declare function _
    findExeByExt(_
        filenameextension as string) as string
'
declare function _
    GetFileVersioningInfo(_
        versinfo() as string,_
        versdesc() as string) as integer
'
dim as string versinfo(8)
dim as string versdesc(7) =>_
    {"CompanyName",_
    "FileDescription",_
    "FileVersion",_
    "InternalName",_
    "LegalCopyright",_
    "OriginalFilename",_
    "ProductName",_
    "ProductVersion"}
'
''=====================================
'
dim as integer res
dim as string tfn,tfext
'
tfext=".xls"
tfn=findExeByExt(tfext)
if tfn="" then
    print "Extension: ";tfext;" not found"
else
'
    versinfo(8)=tfn
    res=GetFileVersioningInfo(versinfo(),versdesc())
    '
    if res>0 then
        print "File: ";versinfo(8)
        print
        for c as integer = 0 to 7
            print versdesc(c);tab(20);rtrim(versinfo(c))
        next
    else
        print "Problem getting VerInf for: ";versinfo(8)
    end if
end if
'
print
print "Sleeping to Exit.."
sleep
'
''===================================== findExeByExt
function _
    findExeByExt(_
        filenameextension as string) as string
'
    #ifndef ASSOCF_INIT_IGNOREUNKNOWN
        #define ASSOCF_INIT_IGNOREUNKNOWN &h400
    #endif
    '
    dim as integer p1,p2,res,tout
    dim as string tfn=filenameextension,tstr
    '
    tout=512
    tstr=space(512)
    '
    res=AssocQueryString(_
                ASSOCF_INIT_IGNOREUNKNOWN,_
                ASSOCSTR_EXECUTABLE,_
                strptr(tfn),NULL,strptr(tstr),@tout)
    '
    if res<>0 then return ""
    if instr(tstr,"rundll32.exe")>0 then return ""
    tstr=left(tstr,tout-1)
    '
    'print tstr ' shows the call that Explorer uses
    '
    p1=instr(ucase(tstr),".EXE ")
    p2=instr(ucase(tstr),!".EXE\"")
    if p1>0 then
        tstr=left(tstr,p1+3)
    elseif p2>0 then
            tstr=left(tstr,p2+4)
            tstr=trim(tstr,!"\"")
    end if
    '
    return tstr
'
end function
'
''===================================== GetFileVersioningInfo
function _
    GetFileVersioningInfo(_
        versinfo() as string,_
        versdesc() as string) as integer
'
    '
    dim as integer bytesread,c,dwHandle,res,verSize
    dim as string buffer,ls,qs,tfn
    dim as ushort ptr b1,b2
    dim as ubyte ptr bptr
    '
    tfn=versinfo(8)
    if dir(tfn)="" then return -1
    '
    verSize=GetFileVersionInfoSize(tfn,@dwHandle)
    if verSize=0 then return -2
    dim as any ptr verdat=callocate(verSize*2)
    '
    res=GetFileVersionInfo(strptr(tfn),dwHandle,verSize*2,verdat)
    '
    res=_
        VerQueryValue(_
            verdat,_
            "\VarFileInfo\Translation",_
            @bptr,_
            @bytesread)
    '
    if bytesread=0 then deallocate(verdat):return -3
    '
    b1=cast(ushort ptr,bptr)
    b2=cast(ushort ptr,bptr+2)
    ls=hex(*b1,4)& hex(*b2,4)
    '
    for c=0 to 7
        '
        qs="\StringFileInfo\" & ls & "\" & versdesc(c)
        res=_
            VerQueryValue(_
                verdat,_
                strptr(qs),_
                @bptr,_
                @bytesread)
        '
        if bytesread>0 then
            buffer=space(bytesread)
            CopyMemory(strptr(buffer),bptr,bytesread)
            versinfo(c)=buffer
        else
            versinfo(c)="N/A"
        end if
        '
    next c
    '
    deallocate(verdat)
    return 1
'
end function


ETA: Code mod
Last edited by Zippy on Mar 26, 2010 17:45, edited 1 time in total.
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » Mar 26, 2010 16:12

Wow! I'm impressed. That's a lot of code to check the version. But, it seems to be quick and works well.
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Postby Zippy » Mar 26, 2010 17:48

phishguy wrote:Wow! I'm impressed. That's a lot of code to check the version. But, it seems to be quick and works well.

I just wanted to get AssocQueryString() working, already had the versioning code (strange stuff). I'm not really suggesting that you use it, you may if you wish.

I formalized the code, changed in my post above. the functions can be used separately.
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » Mar 27, 2010 14:37

Zippy,

I haven't had a chance to do much else with my code. Work and family life have been keeping me pretty busy.

I was wondering, do you think it's possible to automate Open Office with Disphelper? I tried converting the following code and got stuck at the line with "Dim aNoArgs()" and the following line that uses the variable. I'm guessing that it's probably looking for a variant.





Code: Select all

Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
Dim aNoArgs()
Set oCalcDoc = oDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, aNoArgs)
   
Set v = oServiceManager.DefaultContext.getValueByName("/singletons/org.openoffice.vba.theGlobals")
Set ooApp = v.Application
MsgBox ooApp.Version
Set cell = ooApp.ActiveCell
cell.Value = "Hello!"
Set r = ooApp.Range("B1", "B1")
r.Value = "Hi1"
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » Apr 07, 2010 13:37

Has anyone successfully used disphelper with open office? Is it even possible?

Anyway, I haven't had much chance to add anything to my wrapper, except for the xlprint command. That command needs to be enhanced with some of the other print options.
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Postby Zippy » Apr 07, 2010 16:45

@phish

How far did you get with OO? I had OO until frustration drove me back to Office, I no longer have OO..

I had tried to get disphelper and ooCalc working, failed. From my notes (not from memory..) it started failing when passing the VARIANT array (which is null, btw). Rather it started failing at ".loadComponentFromURL", by elimination it had to have been the VARIANT array that disp didn't like. I think this is your same problem.

Here's code stub through that line, the VARIANT array should be ok (I'm using the same array initialization I used to pass the VARIANT array to Excel). I'll bet it still fails for you..

Code: Select all

#include once "windows.bi"
#define UNICODE
#include once "disphelper\disphelper.bi"
#undef UNICODE
'
dhInitialize(TRUE)
dhToggleExceptions(TRUE)
'
dim as HRESULT hres
'
'Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
dim oServiceManager as IDispatch ptr
dhCreateObject("com.sun.star.ServiceManager",NULL,@oServiceManager)
'
'Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
dim oDesktop as IDispatch ptr
hres=dhGetValue("%o",@oDesktop,oServiceManager,".createInstance(%s)","com.sun.star.frame.Desktop")
'
'Dim aNoArgs()
dim As SAFEARRAYBOUND sab(1)
dim aNoArgs as VARIANT
'VariantInit(@aNoArgs)
aNoArgs.vt = VT_ARRAY or VT_VARIANT
sab(0).lLbound = 0 : sab(0).cElements = 1
aNoArgs.parray=SafeArrayCreate(VT_VARIANT,1,cast(SAFEARRAYBOUND Ptr,@sab(0)))
'
'Set oCalcDoc = oDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, aNoArgs)
dim oCalcDoc as IDispatch ptr
'   this is where it blew up on me..
hres=dhGetValue("%o",@oCalcDoc,oDesktop,".loadComponentFromURL(%s,%s,%d,%v)","private:factory/scalc","_blank",0,@aNoArgs)
'
'Set v = oServiceManager.DefaultContext.getValueByName("/singletons/org.openoffice.vba.theGlobals")
dim v as IDispatch ptr
hres=dhGetValue("%o",@v,oServiceManager,".DefaultContext.getValueByName(%s)","/singletons/org.openoffice.vba.theGlobals")


'Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
'Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
'Dim aNoArgs()
'Set oCalcDoc = oDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, aNoArgs)
'   
'Set v = oServiceManager.DefaultContext.getValueByName("/singletons/org.openoffice.vba.theGlobals")
'Set ooApp = v.Application
'MsgBox ooApp.Version
'Set cell = ooApp.ActiveCell
'cell.Value = "Hello!"
'Set r = ooApp.Range("B1", "B1")
'r.Value = "Hi1"

It should be possible using disphelper.. ?
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » Apr 07, 2010 17:06

Zippy,


Yep, that's exactly where it blew up on me. I wasn't sure how to create the variant. It looks like it doesn't even like it if you create the variant. Oh well. I just thought that an automation helper for Open Office would be nice for all the folks that don't have, can't afford, or simply don't want Excel. Plus, it's free. For my purposes, I'll stick with Excel for now.
Zippy
Posts: 1295
Joined: Feb 10, 2006 18:05

Postby Zippy » Apr 07, 2010 18:06

.. It's not a variant. It's a:

com.sun.star.beans.PropertyValue

struct. The problem is creating this struct, then figuring out what param type loadcomponent will accept...

See: Bridge_GetStruct for a "simpler" method to create the struct.

- this is all way beyond my comprehension.

=====

When are you going to post wordHelper ;-)
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » Apr 07, 2010 19:00

Wordhelper? I suppose that could be done. However, as it is, there doesn't even seem to be much interest in the xlhelper. Plus, I don't currently have a personal need for automating Word. Why not add Explorer helper and Access helper too? Aaack! Too many possibilities and not enough time or ambition.

Did you check out the xlprint function? I have an example in the xlhelper project page. I thought that it was kind of a neat way to print a Freebasic graphics screen. Although, there are better ways to do this and it does require that you have Excel.

Return to “Libraries”

Who is online

Users browsing this forum: No registered users and 0 guests