ScriptControl Userlib (OpenSource) beta 2

[ts-soft]

Ist ne kleine UserLib um das MSScript-Control zu nutzen (VBScript oder JScript z.B)

Funktionsbeschreibung und Beispiele sind vorhanden.

Wenn jemand noch Erweiterungen oder Beispiele beisteuern möchte, so
würde es mich freuen.

Wenns stabil läuft, kommt die Lib evtl. in die PBOSL.

PS: Der Sourcecode für die Lib ist dank PB4 < 100 Zeilen

Download

Viel Spaß beim testen.

[Kiffi]

> Ist ne kleine UserLib um das MSScript-Control zu nutzen

Super! Vielen lieben Dank!

> ; some of testcode stolen from kiffi



Hier hasse noch'n Code zum klauen:

Code: Alles auswählen

; Ermittelt alle Hyperlinks auf einer Webseite
; und liefert diese in einem String (sHrefs) zurück

Procedure.s GetAllHtmlHyperlinksVbs(URL$)
  
  Dummy$ = "Set myIE= CreateObject(" + Chr(34) + "InternetExplorer.Application" + Chr(34) + ")" + #CRLF$
  Dummy$ + "Do While myIE.Busy" + #CRLF$
  Dummy$ + "Loop" + #CRLF$
  Dummy$ + "myIE.Visible = 0" + #CRLF$
  Dummy$ + "myIE.Navigate " + Chr(34) + URL$ + Chr(34) + #CRLF$
  Dummy$ + "Do While myIE.ReadyState <> 4" + #CRLF$
  Dummy$ + "Loop" + #CRLF$
  Dummy$ + "Set oDoc = myIE.Document" + #CRLF$
  Dummy$ + "Set oLinks = oDoc.links" + #CRLF$
  Dummy$ + "For each oLink in oLinks" + #CRLF$
  Dummy$ + "sHrefs = sHrefs & oLink.href & vbCRLF" + #CRLF$
  Dummy$ + "Next" + #CRLF$
  Dummy$ + "Set oLinks = Nothing" + #CRLF$
  Dummy$ + "Set oDoc = Nothing" + #CRLF$
  Dummy$ + "Set myIE = Nothing" + #CRLF$
  
  ProcedureReturn Dummy$
  
EndProcedure

SCtr_SetLanguage("VBScript")
SCtr_SetTimeOut(20000)
SCtr_AddCode(GetAllHtmlHyperlinksVbs("http://www.purebasic.com"))
sHRefs.s = SCtr_EvalStr("sHrefs")
If sHRefs
  MessageRequester("Hyperlinks on PureBasic.com", sHRefs)
EndIf

Grüße ... Kiffi

[ts-soft]

Danke fürs Snippet, habs dazugeklaut

Update: SCtr_EvalNum(StringVar.s) sollte auch dort funktionieren, wo Boolean zurückgegeben wird (ich hoffe)

weitere Beispiele:

Code: Alles auswählen

Procedure vbsFileExist(Filename.s)
  Protected Source.s
  SCtr_Reset()
  SCtr_SetLanguage("VBScript")
  Source = "Set oFSO = CreateObject(" + Chr(34) + "Scripting.FileSystemObject" + Chr(34) + ")" + #CRLF$
  Source + "vbsFileExist = oFSO.FileExists(" + Chr(34) + Filename + Chr(34) + ")" + #CRLF$
  SCtr_AddCode(Source)
  If SCtr_EvalNum("vbsFileExist")
    ProcedureReturn #True
  EndIf
EndProcedure

Procedure.s vbsGetSpecialFolder(Directory.s)
  Protected Source.s
  SCtr_Reset()
  SCtr_SetLanguage("VBScript")
  Source = "Set oWShell = CreateObject(" + Chr(34) + "Wscript.Shell" + Chr(34) + ")" + #CRLF$
  Source + "Directory = oWShell.SpecialFolders(" + Chr(34) + Directory.s + Chr(34) + ")" + #CRLF$
  SCtr_AddCode(Source)
  ProcedureReturn SCtr_EvalStr("Directory")
EndProcedure

Procedure vbsCreateShortcut(TargetPath.s, ShortcutLnk.s, WorkingDirectory.s)
  Protected Source.s
  SCtr_Reset()
  SCtr_SetLanguage("VBScript")
  Source = "Set oWShell = CreateObject(" + Chr(34) + "Wscript.Shell" + Chr(34) + ")" + #CRLF$
  Source + "Set ShortcutLnk = oWShell.CreateShortcut(" + Chr(34) + ShortcutLnk.s + Chr(34) + ")" + #CRLF$
  Source + "ShortcutLnk.TargetPath = " + Chr(34) + TargetPath.s + Chr(34) + #CRLF$
  Source + "ShortcutLnk.WorkingDirectory = " + Chr(34) + WorkingDirectory.s + Chr(34) + #CRLF$
  Source + "ShortcutLnk.Save" + #CRLF$
  SCtr_AddCode(Source)
  ProcedureReturn vbsFileExist(ShortcutLnk.s)
EndProcedure

Procedure vbsCreateURLShortcut(TargetPath.s, URLLnk.s)
  Protected Source.s
  SCtr_Reset()
  SCtr_SetLanguage("VBScript")
  Source = "Set oWShell = CreateObject(" + Chr(34) + "Wscript.Shell" + Chr(34) + ")" + #CRLF$
  Source + "Set URLLnk = oWShell.CreateShortcut(" + Chr(34) + URLLnk.s + Chr(34) + ")"  + #CRLF$
  Source + "URLLnk.TargetPath = " + Chr(34) + TargetPath.s + Chr(34) + #CRLF$
  Source + "URLLnk.Save" + #CRLF$
  SCtr_AddCode(Source)
  ProcedureReturn vbsFileExist(URLLnk.s)
EndProcedure

; // Test
Debug vbsCreateShortcut("Notepad.exe", vbsGetSpecialFolder("Desktop") + "\Mein Editor.lnk", "")
Debug vbsCreateURLShortcut("http://www.purebasic.com", vbsGetSpecialFolder("StartMenu") + "\PureBasic.url")

[ts-soft]

Update: SCtr_EvalStr(StringVar.s) unterstützt jetzt auch UNICODE

[Kiffi]

Södele,

hier ist ein kleines Tool, welches die Umwandlung von VBScript in PBCode
ein wenig erleichtert.

Hier kann man es herunterladen (21 kB)



(nicht wundern: ich habe den Screenshot ein wenig eingefärbt, damit man
die Funktionsweise des Programmes besser erkennt)


Kurzanleitung:

Im oberen Textfeld gibt man den VBScript-Code ein. Im unteren Textfeld
wird daraus eine PB-Prozedur generiert. Diese Prozedur liefert das
VBScript als String zurück, welchen man SCtr_Run() oder SCtr_AddCode()
direkt übergeben kann.

Den Namen der Prozedur kann man im oberen Textfeld dadurch festlegen,
indem man innerhalb einer Zeile einen VBScript-Kommentar einleitet,
danach das Schlüsselwort 'procedurename' gefolgt von einem
Gleichheitszeichen und dem Prozedurnamen eingibt (im Screenshot gelb
eingefärbt)

Beispiel:

Code: Alles auswählen

' procedurename = MeineTestProzedur

Hieraus wird im unteren Fenster ein

Code: Alles auswählen

Procedure.s MeineTestProzedur()

Des weiteren kann man Übergabeparameter festlegen (im Screenshot rot
eingefärbt). Diese haben folgende Syntax:

Code: Alles auswählen

' variable = MeineStringVariable.s;DerZuErsetzendeWert

Daraus generiert das Tool folgende Zeile

Code: Alles auswählen

Procedure.s MeineTestProzedur(MeineStringVariable.s)

Der im Screenshot grün eingefärbte Bereich ist optional und bewirkt, dass
alle Vorkommnisse von 'DerZuErsetzendeWert' durch
'MeineStringVariable.s' ersetzt wird.

Ich hoffe, Ihr werdet aus meinen Erläuterungen schlau.
Wenn nicht -> Nachfragen!

Grüße ... Kiffi

[mk-soft]

TOP
Funktion soweit und ist Super zu gebrauchen.

Leider noch Invaild-Memory-Access bei SCtr_EvalStr(...) wenn es die Variable bei VBS nicht gibt.

Beispiel mit Excel Tabelle mit ADODB -> OLEDB

Excel.vbs[*B]

Code: Alles auswählen

dim cnn, rs
dim Namen, Vornamen, Telefon
set cnn = CreateObject("ADODB.Connection")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Ablage\Telefon.xls;Extended Properties=Excel 8.0;"
set rs = CreateObject("ADODB.Recordset")
rs.open "SELECT * FROM [Tabelle1$] WHERE NUMMER = 1", cnn ,2,3
if not rs.eof then
	Namen = rs.Fields("Namen")
	Vornamen = rs.Fields("Vornamen")
	Telefon = rs.Fields("Telefon")
end if

Excel.pb

Code: Alles auswählen

Procedure.s LoadVbsScript(Datei.s)

  temp.s = ""
  If OpenFile(0, datei)
    While Not Eof(0)
      temp + ReadString(0) + #CRLF$
    Wend
  EndIf
  ProcedureReturn temp
EndProcedure

SCtr_SetLanguage("VBScript")
SCtr_SetTimeOut(20000)
SCtr_AddCode(LoadVbsScript("Excel.vbs"))
Debug SCtr_EvalStr("Namen")
Debug SCtr_EvalStr("Vornamen")
Debug SCtr_EvalStr("Telefon")

Excel Tabelle erste Zeile "NUMMER;NAMEN;VORNAMEN;TELEFON"

FF

[ts-soft]

>> Leider noch Invaild-Memory-Access bei SCtr_EvalStr(...) wenn es die Variable bei VBS nicht gibt.
Mit der Funktion bin ich auch noch nicht so ganz zufrieden gewesen. Wäre
nett, wenn Du helfen würdest diese Funktion zu verbessern, weil Variant ist
nicht so ganz mein Fall
Deshalb ja auch OpenSource

Gruß
Thomas

[mk-soft]

Werde ich mir anschauen
Kommt warscheinlich VT_EMTY oder VT_NULL zurück
Muss jetzt aber erstmal weg.

[mk-soft]

An der UserLIB von ts-soft gearbeitet.

Die Funktion SCtr_EvalNum(...) ersetzt durch:
SCtr_EvalDouble, SCtr_EvalFloat, SCtr_EvalLong, SCtr_EvalWord, CStr_EvalByte

Eine Typeumwandlung wird automatisch durchgeführt.

Neue Funktion SCtr_EvalVarType(...) gibt denn Variablentype zurück.
Dieser entspricht den Konstanten für Typen von Variant
Ist das Ergebnis gleich NULL dann konnte die Variable nicht gefunden werden.

DOWNLOAD http://home.arcor.de/m_kastner/MyCodes/ ... ptControl/

FF

[ts-soft]

Alle Erweiterungen von mk-soft sind jetzt auch im Download des ersten
Postings. Desweiteren wurde der VBHelper von Kiffi hinzugefügt.

Hab im Excel-Beispiel noch den absoluten Pfad in einen relativen geändert,
ansonsten sieht man nur nullen

Scheint ja langsam Komplett zu sein