Anlage des Repos

examples/VBS/ArchiveFolder.vbs

@@ -0,0 +1,23 @@
+ArchiveFolder "sub\foo.zip", "..\baz"
+
+Sub ArchiveFolder (zipFile, sFolder)
+
+    With CreateObject("Scripting.FileSystemObject")
+        zipFile = .GetAbsolutePathName(zipFile)
+        sFolder = .GetAbsolutePathName(sFolder)
+
+        With .CreateTextFile(zipFile, True)
+            .Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, chr(0))
+        End With
+    End With
+
+    With CreateObject("Shell.Application")
+        .NameSpace(zipFile).CopyHere .NameSpace(sFolder).Items
+
+        Do Until .NameSpace(zipFile).Items.Count = _
+                 .NameSpace(sFolder).Items.Count
+            WScript.Sleep 1000 
+        Loop
+    End With
+
+End Sub

examples/VBS/Decode VBE to VBS.vbs

@@ -0,0 +1,106 @@
+'*****************************************************
+'************      Autor: Boris Toll      ************
+'P: SCRDEC					//////
+'12:2004					//////
+'File: toVBS.vbs				//////
+'*****************************************************
+' # Description:: Drag & drop the File to decode over the Script
+
+Dim VBEFile, fso
+
+If WScript.Arguments.Count = 0 Then
+	WScript.Echo  "Kein Parameter angegeben"
+Else
+	On Error Resume Next
+	
+	For each Argument in WScript.Arguments
+		VBEFile = VBEFile & Argument & " "
+	Next
+
+	Set fso = WScript.CreateObject("Scripting.FileSystemObject")
+	If fso.FileExists(VBEFile) Then
+		Dim vbe,Conten
+		Set vbe = fso.OpenTextFile(VBEFile, 1)
+		Conten=vbe.readAll
+		CHKerr()
+		vbe.close
+		Set vbe=Nothing
+
+		Const TagInit = "#@~^" '#@~^awQAAA==
+		Const TagFin = "==^#~@" '& chr(0)
+		Dim DebCode, FCode
+		Do
+			FCode=0
+			DebCode = Instr(Conten,TagInit)
+			If DebCode>0 Then
+				If (Instr(DebCode,Conten,"==")-DebCode)=10 Then 'If "==" follows the tag
+					FCode=Instr(DebCode,Conten,TagFin)
+					If FCode>0 Then
+						Conten=Left(Conten,DebCode-1) & _
+						Decode(Mid(Conten,DebCode+12,FCode-DebCode-12-6)) & _
+						Mid(Conten,FCode+6)
+					End If
+				End If
+			End If
+		Loop Until FCode=0
+		
+		des = mid(VBEFile,1,InstrRev(VBEFile,".",-1)) & "vbs"
+
+		Set vbs = fso.OpenTextFile(des, 2, True)
+   			vbs.Write Conten
+				vbs.close
+
+	End If
+	Set fso=Nothing
+
+end if
+
+Function Decode(Csrc)
+	Dim se,i,c,j,index,CsrcTemp
+	Dim tDecode(127)
+	Const Combinaison = "1231232332321323132311233213233211323231311231321323112331123132"
+
+	Set se=WSCript.CreateObject("Scripting.Encoder")
+	For i=9 to 127
+		tDecode(i)="JLA"
+	Next
+	For i=9 to 127
+		CsrcTemp=Mid(se.EncodeScriptFile(".vbs",string(3,i),0,""),13,3)
+		For j=1 to 3
+			c=Asc(Mid(CsrcTemp,j,1))
+			tDecode(c)=Left(tDecode(c),j-1) & chr(i) & Mid(tDecode(c),j+1)
+		Next
+	Next
+	tDecode(42)=Left(tDecode(42),1) & ")" & Right(tDecode(42),1)
+	Set se=Nothing
+
+	Csrc=Replace(Replace(Csrc,"@&",chr(10)),"@#",chr(13))
+	Csrc=Replace(Replace(Csrc,"@*",">"),"@!","<")
+	Csrc=Replace(Csrc,"@$","@")
+	index=-1
+	For i=1 to Len(Csrc)
+		c=asc(Mid(Csrc,i,1))
+		If c<128 Then index=index+1
+		If (c=9) or ((c>31) and (c<128)) Then
+			If (c<>60) and (c<>62) and (c<>64) Then
+				Csrc=Left(Csrc,i-1) & Mid(tDecode(c),Mid(Combinaison,(index mod 64)+1,1),1) & Mid(Csrc,i+1)
+			End If
+		End If
+	Next
+	Decode=Csrc
+End Function
+
+
+Private Function CHKerr()
+
+	if err.number <> 0 then
+		if err.number = 62 then
+			WScript.echo "Fehlercode: " & err.number & vbcrlf & err.description & vbcrlf & "Leere Dateien können nicht umgewandelt werden"
+			err.clear
+		else
+			WScript.echo "Fehlercode: " & err.number & vbcrlf & err.description
+			err.clear
+		end if
+	end if
+
+End Function

examples/VBS/DynamischeArrays.vbs

@@ -0,0 +1,6 @@
+Dim vprglist : Set vprglist = CreateObject("System.Collections.ArrayList")
+...
+If vprogram.LastRunTime = "" Then
+  vprglist.Add vprogram.FullName
+  i = i + 1
+End If

examples/VBS/Encode VBS to VBE.vbs

@@ -0,0 +1,52 @@
+'*****************************************************
+'************      Autor: Boris Toll      ************
+'P: SCRENC					//////
+'12:2004					//////
+'File: toVBE.vbs				//////
+'*****************************************************
+' # Description:: Drag & drop the File to encode over the Script
+
+If WScript.Arguments.Count = 0 Then
+	WScript.Echo  "Kein Parameter angegeben"
+Else
+	On Error Resume Next
+
+	Set fso = CreateObject("Scripting.FileSystemObject")
+
+	For each Argument in WScript.Arguments
+		skript = skript & Argument & " "
+	Next
+
+	Set Codex = fso.OpenTextFile(skript)
+		code = Codex.ReadAll
+		CHKerr()
+		Codex.close
+
+	Set SEncod = CreateObject("Scripting.Encoder")
+		newcode = SEncod.EncodeScriptFile(".vbs", code, 0, "")
+
+	script = fso.GetBaseName(skript)
+	path = fso.GetParentFolderName(skript)
+
+	newname = script & ".vbe"
+	newpathname = fso.BuildPath(path, newname)
+
+	Set newfile = fso.CreateTextFile(newpathname, true)
+		newfile.Write newcode
+		newfile.close
+
+end if
+
+Private Function CHKerr()
+
+	if err.number <> 0 then
+		if err.number = 62 then
+			WScript.echo "Fehlercode: " & err.number & vbcrlf & err.description & vbcrlf & "Leere Dateien können nicht umgewandelt werden"
+			err.clear
+		else
+			WScript.echo "Fehlercode: " & err.number & vbcrlf & err.description
+			err.clear
+		end if
+	end if
+
+End Function

examples/VBS/Get-NewestFile.vbs

@@ -0,0 +1,8 @@
+	Set GetRecentFile = Nothing
+	For Each objFile In objFolder.Files
+		If GetRecentFile is Nothing then
+			Set GetRecentFile = objFile
+		ElseIf objFile.DateLastModified > GetRecentFile.DateLastModified then
+			Set GetRecentFile = objFile
+		End If
+	Next

examples/VBS/Load-VBScriptModule.vbs

@@ -0,0 +1,19 @@
+ Sub Include(file)
+
+  Dim fso, f
+
+  Set fso = CreateObject("Scripting.FileSystemObject")
+  Set f = fso.OpenTextFile(file & ".vbs", 1)
+
+  str = f.ReadAll
+
+  f.Close
+
+  ExecuteGlobal str
+
+End Sub
+
+' Now call Include and then call Doit
+Include "TestModule"
+
+Doit

examples/VBS/TestModule.vbs

@@ -0,0 +1,3 @@
+ Sub Doit
+  MsgBox "Hello"
+End Sub

examples/VBS/WinLine PDFE/FORMEL-RÜCKSTAND.txt

@@ -0,0 +1,40 @@
+'TITLE: FORMEL-RÜCKSTAND
+'Rückstand aus altem Lieferschein?
+'Stand: MK // 14.04.2022
+On Error resume next
+
+WinLineCurrentMandatorNr = Cstr(CWLStart.CurrentCompany.Nr)
+WinLineCurrentYear = cint(CWLStart.CurrentCompany.CompanyYear)
+
+Auftragsnummer = Value (25,44)
+Lieferscheinnummer = Value (25,45)
+Projektnummer = Value (25,136)
+
+SQLQuery_PredecessorDeliveryNote = "" &_
+   "SELECT TOP 1 [C045] from [v250] (NOLOCK) " & vbCrlf & _
+   "WHERE [c025] <> 'L' " & vbCrlf & _
+   "  and [c044] = '" & Auftragsnummer & "' " & vbCrlf & _
+   "  and [c045] IS NOT NULL " & vbCrlf & _
+   "  and [c045] <> '" & Lieferscheinnummer & "' " & vbCrlf & _
+   "  and [c100] > 0 " & vbCrlf & _
+   "  and [c136] = '" & Projektnummer & "' " & vbCrlf & _
+   "  and [c137] = 2 " & vbCrlf & _
+   "  and [c139] in (3,-3) " & vbCrlf & _
+   "  and [mesocomp] = '" & WinLineCurrentMandatorNr & "' " & vbCrlf & _
+   "  and [mesoyear] in (" & WinLineCurrentYear & ",(" & WinLineCurrentYear & "-12)) " & vbCrlf & _
+   "Order by [C022] asc; "
+
+Set Conn = CWLStart.CurrentCompany.Connection
+If (Len(Auftragsnummer) > 0) and (Len(Projektnummer) > 0) Then
+
+   Set SQLQueryResult_PredecessorDeliveryNote  = Conn.Select(SQLQuery_PredecessorDeliveryNote)
+
+   If (SQLQueryResult_PredecessorDeliveryNote.RowCount) > 0 Then
+      ResultValue = "Rückstand aus Lieferschein: " & SQLQueryResult_PredecessorDeliveryNote.value("c045") 
+   Else
+      ResultValue = "" 
+   End if
+
+Else
+  ResultValue = "" 
+End If

examples/VBS/Write-TextFile.vbs

@@ -0,0 +1,6 @@
+Set objFSO=CreateObject("Scripting.FileSystemObject")
+
+outFile="E:\Text.txt"
+Set objFile = objFSO.CreateTextFile(outFile,True)
+objFile.Write "medacom test string" & vbCrLf
+objFile.Close

examples/VBS/test_deduplicate value in array.vbs

@@ -0,0 +1,24 @@
+Set objDictionary = CreateObject("Scripting.Dictionary")
+
+arrItems = Array("a","b","b","c","c","c","d","e","e","e")
+
+For Each strItem in arrItems
+    If Not objDictionary.Exists(strItem) Then
+        objDictionary.Add strItem, strItem   
+    End If
+Next
+
+intItems = objDictionary.Count - 1
+
+ReDim arrItems(intItems)
+
+i = 0
+
+For Each strKey in objDictionary.Keys
+    arrItems(i) = strKey
+    i = i + 1
+Next
+
+For Each strItem in arrItems
+    Wscript.Echo strItem
+Next