COMate - control COM objects via automation - OBSOLETE!

[Kwai chang caine]

I don't think KCC compiles his programs! Instead, I reckon he throws them at his bedroom wall and if they don't stick to the wall then he decides there must be a bug within the code!

Master SROD....you are not, only one of the best world programmer.....
I see you know also laugh and make joke

[dobro]

hum !

who is Léonard ? [Srod,KCC]

who is the Disciple ? [Srod,KCC] ?



that is the question !!

[SFSxOI]

I'm converting this:

Code: Select all

Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile("c:\testfile.txt", True)
MyFile.WriteLine("This is a test.")
MyFile.Close

This is the part I have thats working so far:

Code: Select all

Procedure WMIWrite_to_File()
Define.COMateObject objFSO, MyFile

towrite$ = "Test"
file$ = "C:\testtemp.txt"
create$ = Str(#True)

objFSO = COMate_CreateObject("Scripting.FileSystemObject")

If objFSO
MyFile = objFSO\Invoke("CreateTextFile('" + file$ + "', '" + create$ + "')")

EndIf

objFSO\Release()
EndProcedure

But when i try to convert the rest of it, these two lines:

Code: Select all

MyFile.WriteLine("This is a test.")
MyFile.Close

No matter what i do i always get an invalid memory error. What do I have to do for those two lines to make them work? This doesn't work:

Code: Select all

MyFile\Invoke("WriteLine('" + towrite$ + "')")

I don't think its correct. MyFile is supposed to be a TextStream object thats returned

[Kiffi]

Code: Select all

MyFile = objFSO\Invoke("CreateTextFile('" + file$ + "', '" + create$ + "')")

Code: Select all

MyFile = objFSO\GetObjectProperty("CreateTextFile('" + file$ + "', '" + create$ + "')")

Greetings ... Kiffi

[SFSxOI]

That did it, thanks Kiffi

OK, just some small utility functions for WMI using COMate. Pretty much explainatory, and open to improvement if you wish:

Code: Select all

Procedure WMICreate_Text_File(in_file_name_path.s)
; example: WMICreate_Text_File("C:\test.txt")
Define.COMateObject objFSO
creatfile$ = in_file_name_path
objFSO = COMate_CreateObject("Scripting.FileSystemObject")

If objFSO
objFSO\Invoke("CreateTextFile('" + creatfile$ + "')")
EndIf

objFSO\Release()
EndProcedure

Procedure WMICopy_File(in_file_name_path.s, out_file_name_path.s, overwrit.i) ; in_file_name_path in format C:\tempdir\testfile.txt  - out_file_name_path in format C:\tempdir\
; example: WMICopy_File("C:\test.txt", "C:\temp\", #True)
Define.COMateObject objFSO

OverwriteExisting$ = Str(overwrit)
filetocopy$ = in_file_name_path
filetodest$ = out_file_name_path

objFSO = COMate_CreateObject("Scripting.FileSystemObject")
If objFSO
objFSO\Invoke("CopyFile('" + filetocopy$ + "', '" + filetodest$ + "', '" + OverwriteExisting$ + "')")
EndIf

objFSO\Release()
EndProcedure

Procedure WMICopy_Set_of_Files(in_file_path_mask.s, out_file_path.s, overwrit.i) ; overwrit is #True or #False to overwrite exiting or not
; example: WMICopy_Set_of_Files("C:\*.txt", "C:\temp\", #True) or WMICopy_Set_of_Files("C:\*.txt", "C:\temp\", #False)
Define.COMateObject objFSO

OverwriteExisting$ = Str(overwrit)
filetocopymask$ = in_file_path_mask
filetodest$ = out_file_path

objFSO = COMate_CreateObject("Scripting.FileSystemObject")
If objFSO
objFSO\Invoke("CopyFile('" + filetocopymask$ + "', '" + filetodest$ + "', '" + OverwriteExisting$ + "')")
EndIf

objFSO\Release()
EndProcedure

Procedure WMIMove_File(in_file_name_path.s, out_file_name_dest.s) ; in_file_name_path can contain wildcard characters (i.e.. *.txt) in the last path component only
; out_file_name_dest cannot contain wildcard characters
; example: WMIMove_File("C:\test.txt", "C:\temp\")
; If destination does Not exist, the file gets moved.
; If destination is an existing file, an error occurs.
; If destination is a directory with same name as file, an error occurs. 

Define.COMateObject objFSO

filetomove$ = in_file_name_path
movefiletodest$ = out_file_name_dest

objFSO = COMate_CreateObject("Scripting.FileSystemObject")
If objFSO
objFSO\Invoke("MoveFile('" + filetomove$ + "', '" + movefiletodest$ + "')")
EndIf

objFSO\Release()
EndProcedure

Procedure.s WMIDelete_All_File(in_file_mask_path_delete.s, force.i) ; force = true if files with the read-only attribute set are to be deleted also; false (default) if they are not.
; example: WMIDelete_All_File("C:\temp\*.txt", #True)
; An error occurs if no matching files are found. The DeleteFile method stops on the first error it encounters. No attempt is made to roll back or undo any changes that were made before an error occurred.
Define.COMateObject objFSO

DeleteReadOnly$ = Str(force)
file_mask_to_delete$ = in_file_mask_path_delete

objFSO = COMate_CreateObject("Scripting.FileSystemObject")
If objFSO
sucess_error = objFSO\Invoke("DeleteFile('" + file_mask_to_delete$ + "', '" + DeleteReadOnly$ + "')")
EndIf
If sucess_error <> 0
return_error$ = "No matching files found to delete"
EndIf

objFSO\Release()
ProcedureReturn return_error$
EndProcedure

Procedure WMIDelete_Single_File(in_file_to_delete.s)
; example: WMIDelete_A_File("C:\temp\test.txt", #True)
Define.COMateObject objFSO
fileto_delete$ = in_file_to_delete
objFSO = COMate_CreateObject("Scripting.FileSystemObject")
If objFSO
sucess_error = objFSO\Invoke("DeleteFile('" + fileto_delete$ + "')")
EndIf

objFSO\Release()

EndProcedure

Procedure WMIDelete_A_Folder(in_folder_to_delete.s, force.i) ; force.i is #True if folders with the read-only attribute set are to be deleted also; #False if they are not.
; example: WMIDelete_A_Folder("C:\temp", #True)
;The specified folder is deleted regardless of whether or not it has contents (all contents are deleted too).
Define.COMateObject objFSO

ReadOnly$ = Str(force)
folder_to_delete$ = in_folder_to_delete

objFSO = COMate_CreateObject("Scripting.FileSystemObject")
If objFSO
sucess_error = objFSO\Invoke("DeleteFolder('" + folder_to_delete$ + "', '" + ReadOnly$ + "')")
EndIf

objFSO\Release()

EndProcedure

Procedure WMICreate_A_Folder(in_folder_to_create.s)
; example: WMICreate_A_Folder("C:\temp") or WMICreate_A_Folder("C:\temp\testfolder1") for a sub dir
; for sub folders, folder has to exist first before sub folders are created i.e... C:\temp\testfolder1 has to exist before C:\temp\testfolder1\testfolder2 is created.
Define.COMateObject objFSO

folder_to_create$ = in_folder_to_create

objFSO = COMate_CreateObject("Scripting.FileSystemObject")
If objFSO
objFSO\Invoke("CreateFolder('" + folder_to_create$ + "')")
EndIf

objFSO\Release()

EndProcedure

Procedure WMIRename_File(in_old_name.s, out_new_name.s)
; example: WMIRename_File("C:\test.txt", "C:\test_renamed.txt") or WMIRename_File("C:\test.txt", "C:\test.old") etc...
Define.COMateObject objWMIService, RNFInfo
colRNFInfo.COMateEnumObject
strComputer.s = "."
In_old_name_rename$ = ReplaceString(in_old_name, "\", "\\")
Out_new_name_rename$ = out_new_name

objWMIService = COMate_GetObject("winmgmts:\\" + strComputer + "\root\cimv2", "") 
If objWMIService
  colRNFInfo = objWMIService\CreateEnumeration("ExecQuery('Select * from CIM_DataFile Where Name= $0027" + In_old_name_rename$ +"$0027')")
  If colRNFInfo 
    RNFInfo = colRNFInfo\GetNextObject() 
    While RNFInfo
      
      RNFInfo\Invoke("Rename('" + Out_new_name_rename$ + "')")
      
      RNFInfo\Release() 
      RNFInfo = colRNFInfo\GetNextObject()
    Wend
    colRNFInfo\Release()
  EndIf
  objWMIService\Release()
  Else
      MessageRequester("Error", "RNFInfo")  
EndIf

EndProcedure

Procedure WMIWrite_to_File(file_to_write.s, string_to_write.s)

Define.COMateObject objFSO, MyFile

ForReading$ = Str(1)
ForWriting$ = Str(2)
ForAppending$ = Str(8)
stringtowrite$ = string_to_write
filetowrite$ = file_to_write

objFSO = COMate_CreateObject("Scripting.FileSystemObject")
If objFSO

MyFile = objFSO\GetObjectProperty("OpenTextFile('" + filetowrite$ + "', '" + ForAppending$ + "')")
MyFile\Invoke("WriteLine('" + stringtowrite$ + "')")
MyFile\Invoke("Close()")

EndIf

objFSO\Release()
EndProcedure

Procedure.i If_File_Exists(file_to_check.s) ; where file_to_check.s = full path to the file i.e.. C:\temp\testfile.txt
; returns -1 if the file exists and 0 if it doesn't exist
Define.COMateObject objFSO, MyFile

objFSO = COMate_CreateObject("Scripting.FileSystemObject")
If objFSO

exists.i = objFSO\GetIntegerProperty("FileExists('" + file_to_check + "')")

EndIf

objFSO\Release()
ProcedureReturn exists
EndProcedure

If If_File_Exists("C:\wrtfile.txt") = 0
WMICreate_Text_File("C:\wrtfile.txt")
Delay(1)
EndIf

WMIWrite_to_File("C:\wrtfile.txt", "[Test_Info]")
Delay(1)
WMIWrite_to_File("C:\wrtfile.txt", "This is a test")
Delay(1)
WMIWrite_to_File("C:\wrtfile.txt", "And This is another test")

[SFSxOI]

I got this vbs script:

Code: Select all

strComputer = "."

Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"   
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Visible = 1

Set objWMIService = GetObject _("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _  ("SELECT * FROM Win32_Service")
 
For Each objItem in colItems
    strHTML = objItem.DisplayName  & " = " & objItem.State & "<BR>"
    objExplorer.Document.Body.InnerHTML = strHTML
Next

I got it working kinda, I don't know how to do this part:

Code: Select all

objExplorer.Document.Body.InnerHTML = strHTML

Do I have to do something like this first?

Code: Select all

Document = objExplorer\GetObjectProperty("Document")
Body = documentx\GetObjectProperty("Body")
Body\SetProperty("InnerHTML('" + strHTML$ + "')")

which doesn't make sense really, and besides an exception occurs at:

Document = objExplorer\GetObjectProperty("Document")

[ricardo]

I got it working kinda, I don't know how to do this part:

Code: Select all

objExplorer.Document.Body.InnerHTML = strHTML

The answer can be deduced by this srod's example

Code: Select all

IncludePath ".."
XIncludeFile "COMate.pbi"

Define.COMateObject WebObject


Procedure.i ExecuteJavaScript(Gadget, command$) 
  Protected browser.COMateObject, documentDispatch.COMateObject, script.COMateObject
  Protected result
  browser = COMate_WrapCOMObject(GetWindowLong_(GadgetID(gadget), #GWL_USERDATA)) 
  If browser 
    documentDispatch = browser\GetObjectProperty("Document")
    If documentDispatch
      script = documentDispatch\GetObjectProperty("script")
      If script
        result = script\Invoke("eval('" + command$ + "')")
        script\release()
      EndIf  
      documentDispatch\Release()
    EndIf
    browser\Release()
  EndIf 
  ProcedureReturn result
EndProcedure 


If OpenWindow(0, 10000, 0, 0, 0, "WebGadget",  #PB_Window_SystemMenu|#PB_Window_Maximize)
  WebGadget(0, 0, 0, WindowWidth(0)+50,WindowHeight(0)-100, "http://www.purebasic.fr/english/posting.php?mode=reply&t=33983") 
  ButtonGadget(1,50,WindowHeight(0)-50,150,25,"Fill & Send") 
  Repeat 
    Event = WaitWindowEvent(); 
    Select Event 
      Case #PB_Event_Gadget 
        Select EventGadget() 
          Case 1 
            xMessage$ = "Hello from PB :)" 
            ExecuteJavaScript(0,"document.all.message.value=" + Chr(34) + xMessage$ + Chr(34)) 
            ExecuteJavaScript(0,"document.all.preview.click()") 
;            ExecuteJavaScript(0,"document.post.post.click()")  ;DON'T run this command else it will post in this forum thread!
        EndSelect 
      Case #PB_Event_CloseWindow 
        Break 
    EndSelect 
  Until GetAsyncKeyState_(#VK_ESCAPE) 
EndIf 

[SFSxOI]

Yeah, I saw that before, already tried it with this code:

Code: Select all

Procedure WebPage()

Define.COMateObject objWMIService, objExplorer, objItem, ObjBody, ObjDocument
colItems.COMateEnumObject

strComputer.s = "." 
objExplorer = COMate_CreateObject("InternetExplorer.Application")
aboutblank$ = "about:blank"

objExplorer\Invoke("Navigate('"+ aboutblank$ +"')")   
objExplorer\Invoke("ToolBar('" + Str(0) + "')")
objExplorer\Invoke("StatusBar('" + Str(0) + "')")
objExplorer\Invoke("Visible('"+ Str(1) + "')")

objWMIService = COMate_GetObject("winmgmts:\\" + strComputer + "\root\cimv2", "") 
If objWMIService
  colItems = objWMIService\CreateEnumeration("ExecQuery('Select * from Win32_Service')")
  
  If colItems 
    objItem = colItems\GetNextObject() 
    While objItem
    
    strHTML$ = objItem\GetStringProperty("DisplayName")
    
    ObjDocument = objExplorer\GetObjectProperty("Document")
    ObjBody = ObjDocument\GetObjectProperty("Body")
    ObjBody\SetProperty("InnerHTML('" + strHTML$ + "')") ; < this doesn't support Invoke according to COmate, so trying SetProperty, still dont work
  
      Debug COMate_GetLastErrorDescription()
    
      objItem\Release()
      ObjBody\Release()
      ObjDocument\Release() 
      objItem = colItems\GetNextObject()
    Wend
    colItems\Release() 
  EndIf
  objWMIService\Release()
  Else
  Debug COMate_GetLastErrorDescription()
       
EndIf

EndProcedure

COMate says everything is OK and is not reporting any errors, but it just doesn't work.  Is that supposed to be InnerHTML or is there some type of method to set it that I haven't seen like a putinnerhtml or something? 

[Kiffi]

@SFSxOI: you must collect all informations inside of the while-wend and
put it into the innerHTML after leaving it.

wrong:

Code: Select all

While objItem
 strHTML$ = ...
 [...]
 ObjBody\SetProperty(...
Wend

better:

Code: Select all

While objItem
 strHTML$ + ...
 [...]
Wend
ObjBody\SetProperty(...

Greetings ... Kiffi

P.S.: Why not using the 'good old webgadget'?

[SFSxOI]

You mean like this?

Code: Select all

Procedure WebPage()

Define.COMateObject objWMIService, objExplorer, objItem, ObjBody, ObjDocument
colItems.COMateEnumObject

strComputer.s = "." 
objExplorer = COMate_CreateObject("InternetExplorer.Application")
aboutblank$ = "about:blank"
InHTML$ = "InnerHTML"
objExplorer\Invoke("Navigate('"+ aboutblank$ +"')")   
objExplorer\Invoke("ToolBar('" + Str(0) + "')")
objExplorer\Invoke("StatusBar('" + Str(0) + "')")
objExplorer\Invoke("Visible('"+ Str(1) + "')")

objWMIService = COMate_GetObject("winmgmts:\\" + strComputer + "\root\cimv2", "") 
If objWMIService
  colItems = objWMIService\CreateEnumeration("ExecQuery('Select * from Win32_Service')")
  
  If colItems 
    objItem = colItems\GetNextObject() 
    While objItem
    
    strHTML$ = objItem\GetStringProperty("DisplayName")
    
    ObjDocument = objExplorer\GetObjectProperty("Document")
    ObjBody = ObjDocument\GetObjectProperty("Body")
  
      objItem = colItems\GetNextObject()
    Wend
    ObjBody\SetProperty("innerHTML('" + strHTML$ + "')")
    colItems\Release() 
  EndIf
  objWMIService\Release()
  Else
  Debug COMate_GetLastErrorDescription()
       
EndIf

EndProcedure

But the value changes each pass thru the while:wend, if its outside the while:wend all it will ever get is the last value of the enumeration in strHTML$ ?

[Kiffi]

You mean like this?

Code: Select all

strHTML$ = objItem\GetStringProperty("DisplayName")

no, i mean

Code: Select all

strHTML$ + objItem\GetStringProperty("DisplayName")

here is the complete code:

Code: Select all

Procedure WebPage()
  
  Protected objWMIService.COMateObject
  Protected objExplorer.COMateObject
  Protected objItem.COMateObject
  Protected ObjBody.COMateObject
  Protected ObjDocument.COMateObject
  Protected colItems.COMateEnumObject
  
  Protected strComputer.s
  Protected strHTML$
  
  strComputer = "."
  
  objExplorer = COMate_CreateObject("InternetExplorer.Application")
  
  If objExplorer
    
    objExplorer\Invoke("Navigate('about:blank')")   
    
    objExplorer\SetProperty("ToolBar = #False")
    objExplorer\SetProperty("StatusBar = #False")
    objExplorer\SetProperty("Visible = #True")
    
    objWMIService = COMate_GetObject("winmgmts:\" + strComputer + "\root\cimv2", "")
    If objWMIService
      colItems = objWMIService\CreateEnumeration("ExecQuery('Select * from Win32_Service')")
      
      If colItems
        objItem = colItems\GetNextObject()
        While objItem
          strHTML$ + objItem\GetStringProperty("DisplayName") + " = " + objItem\GetStringProperty("State") + "<br />"
          objItem\Release()
          objItem = colItems\GetNextObject()
        Wend
        colItems\Release()
        
        ObjDocument = objExplorer\GetObjectProperty("Document")
        ObjBody = ObjDocument\GetObjectProperty("Body") 
        
        ObjBody\SetProperty("innerHTML = '" + strHTML$ + "'")
        
        ObjBody\Release()
        ObjDocument\Release()
        
      EndIf
      
      objWMIService\Release()
      
    Else
      Debug COMate_GetLastErrorDescription()
    EndIf
    
    objExplorer\Release()
    
  EndIf
  
EndProcedure
  
WebPage()

Greetings ... Kiffi

[SFSxOI]

Thanks Kiffi, but now i'm more confused then ever. I don't understand why outside the while:wend?

[Kiffi]

I don't understand why outside the while:wend?

the Scripting Guy can explain why

Here is another solution for executing VBS with COMate:

Code: Select all

Procedure.s GetServicesVbs()
  
  Protected VBS.s
  
  VBS + "strComputer = ''.''" + #CRLF$
  VBS + "Set objWMIService = GetObject(''winmgmts:\\'' & strComputer & ''\root\cimv2'')" + #CRLF$
  VBS + "Set colItems = objWMIService.ExecQuery(''SELECT * FROM Win32_Service'')" + #CRLF$
  VBS + "For Each objItem in colItems" + #CRLF$
  VBS + "	strHTML = strHTML & objItem.DisplayName  & '' = '' & objItem.State & ''<BR>''" + #CRLF$
  VBS + "Next" + #CRLF$

  VBS = ReplaceString(VBS, "''", Chr(34))
  
  ProcedureReturn VBS
  
EndProcedure

Procedure.s ExecuteVbs()
  
  Protected ScriptControl.COMateObject
  Protected VBS.s
  Protected ReturnString.s
  
  ScriptControl = COMate_CreateObject("ScriptControl")
  ScriptControl\SetProperty("Language = 'VBScript'")
  
  VBS = GetServicesVbs()
  
  ScriptControl\Invoke("AddCode('" + VBS + "')")
  
  ReturnString = ScriptControl\GetStringProperty("Eval('strHTML')")

  ScriptControl\Release()
  
  ProcedureReturn ReturnString
  
EndProcedure

If OpenWindow(0, 0, 0, 600, 300, "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  WebGadget(0, 10, 10, 580, 280, "about:blank")
  While WindowEvent() : Wend
  SetGadgetItemText(0, #PB_Web_HtmlCode, ExecuteVbs())
  Repeat 
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

i think this is less work than convert the vbs into PB-COMate-Code (and
it's faster).

Greetings ... Kiffi

// Edit

Insert While WindowEvent() : Wend after WebGadget(0, ...).
Thanks to srod!

[srod]

Nice example Kiffi.

[SFSxOI]

Kiffi;

It was a nice example, however, the first 'COMate' one worked fine, the second 'VBS' one doesn't work, at least not here. Just a blank window.