'*** 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 )