'*** v8.4 *** www.dieseyer.de ******************************* 

' 

' Datei:  ProzedurInTxt.vbs 

' Autor:  dieseyer@gmx.de 

' Auf:    www.dieseyer.de 

' 

' Übergibt (aus dem aktuellen VBS) den Inhalt einer Prozedur, 

' um einfach aus Skripten heraus Skripte mit Sub- oder 

' Function-Prozeduren zu erstellen - die 'spielereien' mit 

' den Anführungszeichen übernimmt dabei das Skript. 

' 

'************************************************************ 

 

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl 

 

MsgBox ProzedurInTxt( "SinnLOS" ) 

 

WScript.Quit 

 

 

Function SinnLos( XXX ) 

  MsgBox "Ist das nicht sinnlos?!" 

End Function ' SinnLos( XXX ) 

 

 

'*** v8.4 *** www.dieseyer.de **************************** 

Function ProzedurInTxt( ProzName ) 

'********************************************************* 

' Übergibt (aus dem aktuellen VBS) den Inhalt einer Prozedur 

 

  ProzName = LCase( ProzName ) 

Dim i 

  Dim fso		: Set fso		= WScript.CreateObject("Scripting.FileSystemObject") 

  Dim Txt, Tst, Tyt, ZeileAkt, ProzOK 

  ProzOK = "-OK" 

 

  Txt = "'*********************************************************" 

 

  Dim FileIn : Set FileIn  = fso.OpenTextFile( WScript.ScriptFullName, 1 ) 

  Do While Not ( FileIn.atEndOfStream ) 

 

	ZeileAkt = FileIn.Readline 

	Tst = LCase( ZeileAkt ) 

 

	If ProzOK = "-OK" Then 

	  Tyt = InStr( Tst, "function "	& ProzName ) : If Tyt > 0 AND Tyt < 4 Then ProzOK = "OK" 

	  Tyt = InStr( Tst, "sub "	& ProzName ) : If Tyt > 0 AND Tyt < 4 Then ProzOK = "OK" 

	End If 

 

	If ProzOK = "OK" Then Txt = Txt & vbCRLF & ZeileAkt ' : MsgBox now() & vbCRLF & Txt, , "50 :: " : i = i + 1 : If i > 10 Then WScript.Quit 

 

	If ProzOK = "OK" AND InStr( Tst, "end function" )		> 0 Then Exit Do 

	If ProzOK = "OK" AND InStr( Tst, "end sub" )			> 0 Then Exit Do 

 

  Loop 

 

  FileIn.Close : Set FileIn  = nothing 

 

	Txt = Txt & vbCRLF & "'*********************************************************" 

 

  ProzedurInTxt = Txt ' : MsgBox now() & vbCRLF & ProzedurInTxt, , "61 :: " 

 

End Function ' ProzedurInTxt( ProzName )