PureDispHelper UserLib - Update with Includefile for Unicode

[Flype]

download link seems broken

[ts-soft]

download link seems broken

No problem, the link goes to purearea.net and than to me webspace:
http://www.purearea.net/pb/showcase/show.php?id=413

[Flype]

well sorry it was my internet conn which was not fully functional.

thanks.

[Flype]

little present.

new example : firewall.pb

it enable/disable the firewall of windows.

Code: Select all

EnableExplicit

Define.l objShell 
Define.l objFwMgr
Define.b bResult
Define.l oProfile

dhToggleExceptions(#True)

objShell = dhCreateObject("Shell.Application")

If objShell
  
  dhGetValue("%b", @bResult, objShell, "IsServiceRunning(%T)", @"SharedAccess")
  
  If bResult
    
    objFwMgr = dhCreateObject("HNetCfg.FwMgr")
    
    If objFwMgr
      
      dhGetValue("%o", @oProfile, objFwMgr, ".LocalPolicy.CurrentProfile")
      
      If oProfile
        
        dhGetValue("%b", @bResult, oProfile, ".FirewallEnabled")
        
        If bResult
          
          If MessageRequester("Information", "Firewall is enable." + #LF$ + "Do you want to disable the Firewall ?", #MB_OKCANCEL) = #IDOK
            dhPutValue(oProfile, ".FirewallEnabled = %b", #False)
          EndIf
          
        Else
          
          If MessageRequester("Information", "Firewall is disabled." + #LF$ + "Do you want to enable the Firewall ?", #MB_OKCANCEL) = #IDOK
            dhPutValue(oProfile, ".FirewallEnabled = %b", #True)
          EndIf
          
        EndIf
        
      EndIf
      
      dhReleaseObject(objFwMgr) 
      
    EndIf
    
  Else
    
    dhCallMethod(objShell, ".ServiceStart(%T, %b)", @"SharedAccess", #True)
    
  EndIf
  
  dhReleaseObject(objShell) 

EndIf

[ts-soft]

I don't use the windows firewall
Thank you

[Flype]

now with this snippet you can disable it

just two little procs for those who use it

Code: Select all

Procedure EnableFirewall(bool.b)
  
  Protected objShell.l, objFwMgr.l, bResult.b
  
  objShell = dhCreateObject("Shell.Application")
  If objShell
    dhGetValue("%b", @bResult, objShell, "IsServiceRunning(%T)", @"SharedAccess")
    If bResult
      objFwMgr = dhCreateObject("HNetCfg.FwMgr")
      If objFwMgr
        dhPutValue(objFwMgr, ".LocalPolicy.CurrentProfile.FirewallEnabled = %b", bool)
        dhReleaseObject(objFwMgr) 
      EndIf
    EndIf
    dhReleaseObject(objShell) 
  EndIf
  
EndProcedure

Procedure.b IsFirewallEnabled()
  
  Protected objShell.l, objFwMgr.l, bResult.b
  
  objShell = dhCreateObject("Shell.Application")
  If objShell
    dhGetValue("%b", @bResult, objShell, "IsServiceRunning(%T)", @"SharedAccess")
    If bResult
      objFwMgr = dhCreateObject("HNetCfg.FwMgr")
      If objFwMgr
        dhGetValue("%b", @bResult, objFwMgr, ".LocalPolicy.CurrentProfile.FirewallEnabled")
        dhReleaseObject(objFwMgr) 
      EndIf
    EndIf
    dhReleaseObject(objShell) 
  EndIf
  
  ProcedureReturn bResult
  
EndProcedure

; Active/Désactive le Firewall

#ComTrue = -1

EnableFirewall(#ComTrue - IsFirewallEnabled())

[byo]

Nice example, Flype.
Having fun.

[r_hyde]

Thought I'd throw this in from the Windows forum. It's a little example I threw together for using MS Message Queueing, which can be really nice, for example, for interprocess communication between interdependent services running on separate servers across a network.

Code: Select all

#MQ_RECEIVE_ACCESS = 1 
#MQ_SEND_ACCESS = 2 
#MQ_PEEK_ACCESS = 32 
#MQ_DENY_NONE = 0 
#MQ_DENY_RECEIVE_SHARE = 1 
#MQ_NO_TRANSACTION = 0 
#MQ_MTS_TRANSACTION = 1 
#MQ_XA_TRANSACTION = 2 
#MQ_SINGLE_MESSAGE = 3 
#MQ_ERROR_QUEUE_NOT_EXIST = -1072824317 
#MQMSG_ACKNOWLEDGMENT_FULL_REACH_QUEUE = 5 
#MQMSG_ACKNOWLEDGMENT_FULL_RECEIVE = 14 
#DEFAULT_MAX_TIME_TO_REACH_QUEUE = 20 

qi = dhCreateObject("MSMQ.MSMQQueueInfo.1") 
dhPutValue(qi, "PathName=%s", @".\private$\TestQueue") 

;Send a message 
dhGetValue("%o", @myq, qi, "Open(%d,%d)", #MQ_SEND_ACCESS, #MQ_DENY_NONE) 

If myq 
  Debug "Opened private$\TestQueue for sending" 
  out_msg = dhCreateObject("MSMQ.MSMQMessage.1") 
  body.s = "Hello MSMQ!" 
  label.s = "TestMessage" 
  dhPutValue(out_msg, "Label=%s", @label) 
  dhPutValue(out_msg, "Body=%s", @body) 
  Debug "   sending message 'TestMessage' with content='Hello MSMQ!'" 
  dhCallMethod(out_msg, "Send(%o)", myq) 
  dhReleaseObject(out_msg) 
  
  dhCallMethod(myq, "Close()") 
  Debug "Queue closed" 
  dhReleaseObject(myq) 
EndIf 

Debug "" 

;Receive the message 
dhGetValue("%o", @myq, qi, "Open(%d,%d)", #MQ_RECEIVE_ACCESS, #MQ_DENY_NONE) 

If myq 
  Debug "Opened private$\TestQueue for receiving" 
  dhGetValue("%o", @in_msg, myq, "Receive()") 
  If msg 
    dhGetValue("%s", @message, in_msg, "Body") 
    Debug "   Message received: '" + PeekS(message) + "'" 
    dhReleaseObject(in_msg) 
  EndIf 
  dhCallMethod(myq, "Close()") 
  Debug "Queue closed" 
  dhReleaseObject(myq) 
EndIf 

dhReleaseObject(qi)

This assumes you have already created a private queue named TestQueue. It's not much extra work to create queues programmatically.

[blackborg]

and there are no examples of using dhGetObject.

I want to mimic this from vbs:

Code: Select all

set myUser = GetObject("LDAP://cn=UserNameMe,cbn=users dc=domain,dc=net)

Any ideas..

[Xombie]

Does anyone know if Crystal Reports (specifically version XI) works with this?

If so, how would that work for distributing the apps? If it works, I'd be tempted to purchase Crystal Reports for a small project.

[DoubleDutch]

I've been reading the DispHelper help file and a lot of the information on releasing memory ( eg dhFreeString(lpString.l) ) also says:

"It is recommended to put the variable afterwards on 0"

I have no idea what this means? Does it mean put a zero in the variable used to point to the object or something?

[DoubleDutch]

I've had a go with DispHelper to have an Microsoft Agent in my app, is there any way of getting messages such as if the used had hidden the Agent or moved the Agent?

Edit:

Don't worry. Figured it all out.

[DoubleDutch]

TS-Soft: I think there is either a problem with PB V4.10 B4 or yourDispHelper .lib file. If you check out your "example_agent.pb" demo on PureBasic V41.0 B4 you will see what I mean.

Can anyone else confirm they see the problem with this and PBV4.10 B4?

[SimpleMind]

This is HOT! Nothing to say more....

[mskuma]

I agree - this is great. I tried it last night & noticed a couple of apparent ASM issues reported when using this in unicode.. compiling example_excel.pb (in DispHelper_Include) I got:

unresolved external symbol: '_SafeArrayGetVartype'

and in another pb file, this one http://www.purebasic.fr/english/viewtopic.php?t=29054

Naturally I'm hanging out for the unicode fixes so this lib can be useful in unicode!