PureDispHelper UserLib - Update with Includefile for Unicode

ts-soft · Post by **ts-soft** » Sat Apr 21, 2007 12:57 pm

simple regex example added

; 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")

Post by **Kiffi** » Sat Apr 21, 2007 1:10 pm

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

akj · Post by **akj** » Sat Apr 21, 2007 1:12 pm

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?

ts-soft · Post by **ts-soft** » Sat Apr 21, 2007 1:23 pm

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

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

ts-soft · Post by **ts-soft** » Sat Apr 21, 2007 3:44 pm

Added english and german examples to use 'AutoItX3.dll'
as ActiveX (dll and help included)

Functions to register / unregister ActiveX Dlls also includes.

akj · Post by **akj** » Sat Apr 21, 2007 5:45 pm

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?

ts-soft · Post by **ts-soft** » Sat Apr 21, 2007 5:55 pm

@akj
I see no bug

Code: Select all

dhCallMethod(oAU3, "Opt(%s, %d)", @"SendKeyDownDelay", 200)

works fine here, key is very slow

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

akj · Post by **akj** » Sat Apr 21, 2007 6:19 pm

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

ricardo · Post by **ricardo** » Sat Apr 21, 2007 6:23 pm

netmaestro wrote:Most excellent contribution, should be taken native! Thanks so much for this.

Agree!

This is just awesome. Thanks!!

ts-soft · Post by **ts-soft** » Sat Apr 21, 2007 6:29 pm

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

ricardo · Post by **ricardo** » Sat Apr 21, 2007 6:37 pm

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

akj · Post by **akj** » Sat Apr 21, 2007 6:55 pm

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

ts-soft · Post by **ts-soft** » Sat Apr 21, 2007 9:41 pm

Sendkey without AutoIt

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

fsw · Post by **fsw** » Sat Apr 21, 2007 10:27 pm

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

r_hyde · Post by **r_hyde** » Sun Apr 22, 2007 7:35 am

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.

PureBasic Forums - English

PureDispHelper UserLib - Update with Includefile for Unicode

Possible Bug in AutoItX