PureBasic Forums - English

Posted: **Mon Jul 09, 2007 10:02 am**

download link seems broken

Posted: **Mon Jul 09, 2007 3:28 pm**

Flype wrote: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

Posted: **Mon Jul 09, 2007 3:39 pm**

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

thanks.

Posted: **Tue Aug 14, 2007 9:45 pm**

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

Posted: **Tue Aug 14, 2007 9:51 pm**

I don't use the windows firewall

Thank you

Posted: **Tue Aug 14, 2007 10:03 pm**

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())

Posted: **Wed Aug 15, 2007 3:23 am**

Nice example, Flype.
Having fun.

Posted: **Wed Aug 15, 2007 9:53 am**

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.

Posted: **Sat Aug 18, 2007 1:45 am**

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..

Posted: **Fri Sep 21, 2007 4:17 pm**

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.

Posted: **Fri Sep 28, 2007 1:23 pm**

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

DispHelper .chm file wrote:"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?

Posted: **Fri Sep 28, 2007 4:24 pm**

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.

Posted: **Tue Oct 09, 2007 8:03 am**

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?

Posted: **Tue Oct 16, 2007 8:08 pm**

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

Posted: **Tue Oct 16, 2007 10:04 pm**

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!

PureBasic Forums - English

PureDispHelper UserLib - Update with Includefile for Unicode

This is really great