PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PureDispHelper UserLib - Update with Includefile for Unicode

https://www.purebasic.fr/english/viewtopic.php?t=26744

Page 3 of 18

Posted: Sat Apr 21, 2007 12:57 pm
by ts-soft
simple regex example added

Code: Select all

; c example from disphelper
; adapted to PB by ts-soft

EnableExplicit

dhToggleExceptions(#True)

Procedure.s Replace(szPattern.s, szString.s, szReplacement.s, bIgnoreCase.l = #True)
  Protected regEx.l, Result.l, szResult.s
  
  If bIgnoreCase <> 0 : bIgnoreCase = 1 : EndIf
  
  regEx = dhCreateObject("VBScript.RegExp")
  
  If regEx
    dhPutValue(regEx, ".Pattern = %s", @szPattern)
    dhPutValue(regEx, ".IgnoreCase = %b", bIgnoreCase)
    dhPutValue(regEx, ".Global = %b", #True)
    
    dhGetValue("%s", @Result, regEx, ".Replace (%s,%s)", @szString, @szReplacement)
    
    If Result
      szResult = PeekS(Result)
      dhFreeString(Result)
    EndIf
    
    dhReleaseObject(regEx)
  EndIf
  ProcedureReturn szResult
EndProcedure

Debug Replace("fox", "The quick brown fox jumped over the lazy dog.", "cat")

Posted: Sat Apr 21, 2007 1:10 pm
by Kiffi
Here is another simple example to read rss-feeds:

Code: Select all

EnableExplicit

Define.l oXMLHTTP, oDoc, oNodeList, oNode

Procedure.s GetNodeText(oNode, xPath.s)
  Protected szResponse.l
  Protected ReturnValue.s
  dhGetValue("%s", @szResponse, oNode, "SelectSingleNode(%s).Text", @xPath)
  If szResponse
    ReturnValue = PeekS(szResponse)
    dhFreeString(szResponse) : szResponse = 0
  EndIf
  ProcedureReturn ReturnValue
EndProcedure
  
oXMLHTTP = dhCreateObject("MSXML2.ServerXMLHTTP")

If oXMLHTTP
  
  dhCallMethod(oXMLHTTP, ".Open %s, %s, %b", @"GET", @"http://www.codeproject.com/webservices/articlerss.aspx?cat=6", #False)
  dhCallMethod(oXMLHTTP, ".Send")
  
  dhGetValue("%o", @oDoc, oXMLHTTP, "ResponseXML")
  
  If oDoc
    
    dhGetValue("%o", @oNodeList, oDoc, "SelectNodes(%s)",  @"rss/channel/item")
    
    If oNodeList
      
      Repeat
        
        dhGetValue("%o", @oNode, oNodeList, ".NextNode")
        
        If oNode = 0
          Break
        EndIf
        
        Debug "subject: "     + GetNodeText(oNode, "subject")
        Debug "title: "       + GetNodeText(oNode, "title")
        Debug "description: " + GetNodeText(oNode, "description")
        Debug "link: "        + GetNodeText(oNode, "link")
        Debug "author: "      + GetNodeText(oNode, "author")
        Debug "category: "    + GetNodeText(oNode, "category")
        Debug "pubDate: "     + GetNodeText(oNode, "pubDate")
        
        Debug "---------------------------------"          
        
        dhReleaseObject(oNode)     : oNode=0
        
      ForEver
      
      dhReleaseObject(oNodeList) : oNodeList=0
      
    EndIf
    
    dhReleaseObject(oDoc) : oDoc=0

  EndIf
  
  dhReleaseObject(oXMLHTTP) : oXMLHTTP = 0 
  
EndIf
Greetings ... Kiffi

Posted: Sat Apr 21, 2007 1:12 pm
by akj
On running MediaPlayer.pb in Debug mode I get error "Invalid memory access" in line 17:

Code: Select all

dhPutValue(obj, "Volume = %e", 100)
I am using PB 4.02 under Windows ME.

Does anyone know the correction needed to this line?

Posted: Sat Apr 21, 2007 1:23 pm
by ts-soft
akj wrote:On running MediaPlayer.pb in Debug mode I get error "Invalid memory access" in line 17:

Code: Select all

dhPutValue(obj, "Volume = %e", 100)
I am using PB 4.02 under Windows ME.

Does anyone know the correction needed to this line?
test this:

Code: Select all

dhPutValue(obj, "Volume = %e", 100.0)
%e is a Double

Or rem this line, sets only the volume to full-power :wink:

//edit
FileSystemObject:

Code: Select all

EnableExplicit

dhToggleExceptions(#True)

Procedure FileExists(file.s)
  Protected oFSO.l, Result.l
  
  oFSO = dhCreateObject("Scripting.FileSystemObject")
  If oFSO
    dhGetValue("b%", @Result, oFSO, "FileExists(%s)", @file)
    dhReleaseObject(oFSO)
    If Result = 0
      ProcedureReturn #False
    Else
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure

Procedure FolderExists(folder.s)
  Protected oFSO.l, Result.l
  
  oFSO = dhCreateObject("Scripting.FileSystemObject")
  If oFSO
    dhGetValue("b%", @Result, oFSO, "FolderExists(%s)", @folder)
    dhReleaseObject(oFSO)
    If Result = 0
      ProcedureReturn #False
    Else
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure

Procedure.s GetTempName()
  Protected oFSO.l, Result.l, szResult.s
  
  oFSO = dhCreateObject("Scripting.FileSystemObject")
  If oFSO
    dhGetValue("s%", @Result, oFSO, "GetTempName")
    If Result
      szResult = PeekS(Result)
      dhFreeString(Result)
    EndIf
    dhReleaseObject(oFSO)
  EndIf
  ProcedureReturn szResult
EndProcedure

Procedure.s GetBaseName(file.s)
  Protected oFSO.l, Result.l, szResult.s
  
  oFSO = dhCreateObject("Scripting.FileSystemObject")
  If oFSO
    dhGetValue("s%", @Result, oFSO, "GetBaseName(%s)", @file)

    If Result
      szResult = PeekS(Result)
      dhFreeString(Result)
    EndIf
    dhReleaseObject(oFSO)
  EndIf
  ProcedureReturn szResult
EndProcedure

Debug FileExists("c:\autoexec.bat")
Debug FolderExists("c:\windows")
Debug GetTempName()
Debug GetBaseName(ProgramFilename())

Posted: Sat Apr 21, 2007 3:44 pm
by ts-soft
Added english and german examples to use 'AutoItX3.dll'
as ActiveX (dll and help included)

Functions to register / unregister ActiveX Dlls also includes.

Possible Bug in AutoItX

Posted: Sat Apr 21, 2007 5:45 pm
by akj
In the supplied AutoItX example of calculator.pb setting the option

Code: Select all

dhCallMethod(oAU3, "Opt(%s, %d)", @"SendKeyDownDelay", delay)
does not seem to affect the time the key is held down, but rather the pause between sent keystrokes i.e. it acts more like

Code: Select all

dhCallMethod(oAU3, "Opt(%s, %d)", @"SendKeyDelay", delay)
Is this a bug?

Posted: Sat Apr 21, 2007 5:55 pm
by ts-soft
@akj
I see no bug

Code: Select all

dhCallMethod(oAU3, "Opt(%s, %d)", @"SendKeyDownDelay", 200)
works fine here, key is very slow :wink:

But AutoItX is a beta version, you should use the AutoIt-Forum!

Posted: Sat Apr 21, 2007 6:19 pm
by akj
Is there any PureDsipHelper equivalent for the following which is extracted from the C version file word.c ?

Code: Select all

/* Enumerate each document */

FOR_EACH(wdDoc, wdApp, L".Documents")
{
	// Do something here...
} NEXT(wdDoc);

Posted: Sat Apr 21, 2007 6:23 pm
by ricardo
netmaestro wrote:Most excellent contribution, should be taken native! Thanks so much for this.
Agree!

This is just awesome. Thanks!!

Posted: Sat Apr 21, 2007 6:29 pm
by ts-soft
@akj
FOR_EACH isn't supported by PureDispHelper, but there should another way
for this, but i have no MS-Office and no Information over this.

Posted: Sat Apr 21, 2007 6:37 pm
by ricardo
akj wrote:Is there any PureDsipHelper equivalent for the following which is extracted from the C version file word.c ?

Code: Select all

/* Enumerate each document */

FOR_EACH(wdDoc, wdApp, L".Documents")
{
	// Do something here...
} NEXT(wdDoc);
You need to find how many wdDoc objetcs are and use a FOR

Posted: Sat Apr 21, 2007 6:55 pm
by akj
Thank you, ricardo.

I presume there will be a Documents.Count property I can use to do this, followed by a loop involving something like Documents.Document(i).Name

Posted: Sat Apr 21, 2007 9:41 pm
by ts-soft
Sendkey without AutoIt :wink:

Code: Select all

EnableExplicit

Define oWScript = dhCreateObject("WScript.Shell")

dhToggleExceptions(#True)

If oWScript
  dhCallMethod(oWScript, "Run(%s)", @"calc")
  Delay(100)
  dhCallMethod(oWScript, "AppActivate(%s)", @"Calculator"); english
  ;dhCallMethod(oWScript, "AppActivate(%s)", @"Rechner"); german
  Delay(100)
  dhCallMethod(oWScript, "SendKeys(%s)", @"1{+}")
  Delay(500)
  dhCallMethod(oWScript, "SendKeys(%s)", @"2")
  Delay(500)
  dhCallMethod(oWScript, "SendKeys(%s)", @"~")
  Delay(500)
  dhCallMethod(oWScript, "SendKeys(%s)", @"*3")
  Delay(500)
  dhCallMethod(oWScript, "SendKeys(%s)", @"~")
  Delay(2500)
  dhCallMethod(oWScript, "SendKeys(%s)", @"%{F4}")
  dhReleaseObject(oWScript)
EndIf

Posted: Sat Apr 21, 2007 10:27 pm
by fsw
akj wrote:On running MediaPlayer.pb in Debug mode I get error "Invalid memory access" in line 17:

Code: Select all

dhPutValue(obj, "Volume = %e", 100)
I am using PB 4.02 under Windows ME.

Does anyone know the correction needed to this line?
Here the app crashes in debug mode, no hint from the debugger.
Found out that as soon this line

obj = dhCreateObject("MediaPlayer.MediaPlayer", WindowID(0))

is reached it crashes.

Compiled as app works as expected.

OS is WinXP-MCE2005

Posted: Sun Apr 22, 2007 7:35 am
by r_hyde
I'm getting an error with the following code on Windows 2K & XP:

Code: Select all

EnableExplicit

Define.l obj
Define.s ImagePath

dhToggleExceptions(#False)

If OpenWindow(0, #PB_Ignore, #PB_Ignore, 600, 470, "ImgEdit", #PB_Window_Default_Sizeable)

  obj = dhCreateObject("Imaging.EditCtrl.1", WindowID(0))
  
  If obj
    ImagePath = "C:\01.tif"
    dhPutValue(obj, "Image = %s", @ImagePath)
  EndIf
  
  While WaitWindowEvent() <> #PB_Event_CloseWindow : Wend
  
  dhReleaseObject(obj)
  CloseWindow(0)
  
EndIf
This is the Kodak Image Edit control that ships with Win2K (I've manually copied and registered it on XP). The control is tested & working fine from VB, C, & Python/COM, but it crashes with a memory access error on the dhPutValue statement.
All times are UTC+01:00
Page 3 of 18

Powered by phpBB® Forum Software © phpBB Limited