WeixiangYan/CodeTransOcean huggingface dataset:
Task: Longest string challenge








VB: 

Set objfso = CreateObject("Scripting.FileSystemObject")
Set objfile = objfso.OpenTextFile(objfso.GetParentFolderName(WScript.ScriptFullName) &_
	"\input.txt",1)

list = ""
previous_line = ""
l = Len(previous_line)

Do Until objfile.AtEndOfStream
	current_line = objfile.ReadLine
	If Mid(current_line,l+1,1) <> "" Then
		list = current_line & vbCrLf
		previous_line = current_line
		l = Len(previous_line)
	ElseIf Mid(current_line,l,1) <> ""  And Mid(current_line,(l+1),1) = "" Then
		list = list & current_line & vbCrLf
	End If
Loop

WScript.Echo list

objfile.Close
Set objfso = Nothing
Task: Sorting algorithms_Pancake sort








VB: 


Public Sub printarray(A)
  For i = LBound(A) To UBound(A)
    Debug.Print A(i),
  Next
  Debug.Print
End Sub

Public Sub Flip(ByRef A, p1, p2, trace)

 If trace Then Debug.Print "we
 Cut = Int((p2 - p1 + 1) / 2)
 For i = 0 To Cut - 1
   
   temp = A(i)
   A(i) = A(p2 - i)
   A(p2 - i) = temp
 Next
End Sub

Public Sub pancakesort(ByRef A(), Optional trace As Boolean = False)


lb = LBound(A)
ub = UBound(A)
Length = ub - lb + 1
If Length <= 1 Then 
  Exit Sub
End If

For i = ub To lb + 1 Step -1
  
  P = lb
  Maximum = A(P)
  For j = lb + 1 To i
    If A(j) > Maximum Then
      P = j
      Maximum = A(j)
    End If
  Next j
  
  If P < i Then
    
    If P > 1 Then
      Flip A, lb, P, trace
      If trace Then printarray A
    End If
    
    Flip A, lb, i, trace
    If trace Then printarray A
  End If
Next i
End Sub


Public Sub TestPancake(Optional trace As Boolean = False)
Dim A()
A = Array(5, 7, 8, 3, 1, 10, 9, 23, 50, 0)
Debug.Print "Initial array:"
printarray A
pancakesort A, trace
Debug.Print "Final array:"
printarray A
End Sub
Task: Call a function








VB: 


Function no_arguments() As String
    no_arguments = "ok"
End Function


Function fixed_number(argument1 As Integer, argument2 As Integer)
    fixed_number = argument1 + argument2
End Function


Function optional_parameter(Optional argument1 = 1) As Integer
    
    optional_parameter = argument1
End Function


Function variable_number(arguments As Variant) As Integer
    variable_number = UBound(arguments)
End Function


Function named_arguments(argument1 As Integer, argument2 As Integer) As Integer
    named_arguments = argument1 + argument2
End Function


Function statement() As String
    Debug.Print "function called as statement"
    statement = "ok"
End Function





Function return_value() As String
    return_value = "ok"
End Function






Sub foo()
    Debug.Print "subroutine",
End Sub

Function bar() As String
    bar = "function"
End Function


Function passed_by_value(ByVal s As String) As String
    s = "written over"
    passed_by_value = "passed by value"
End Function

Function passed_by_reference(ByRef s As String) As String
    s = "written over"
    passed_by_reference = "passed by reference"
End Function





Sub no_parentheses(myargument As String)
    Debug.Print myargument,
End Sub


Public Sub calling_a_function()
    
    Debug.Print "no arguments", , no_arguments
    Debug.Print "no arguments", , no_arguments()
    
    
    
    Debug.Print "fixed_number", , fixed_number(1, 1)
    
    
    Debug.Print "optional parameter", optional_parameter
    Debug.Print "optional parameter", optional_parameter(2)
    
    
    Debug.Print "variable number", variable_number([{"hello", "there"}])
    
    
    
    Debug.Print "named arguments", named_arguments(argument2:=1, argument1:=1)
    
    
    statement
    
    
    s = "no_arguments"
    Debug.Print "first-class context", Application.Run(s)
    
    
    
    returnvalue = return_value
    Debug.Print "obtained return value", returnvalue
    
    
    
    
    foo
    Debug.Print , bar
    
    
    Dim t As String
    t = "unaltered"
    Debug.Print passed_by_value(t), t
    Debug.Print passed_by_reference(t), t
    
    
    
    
    
    no_parentheses "calling a subroutine"
    Debug.Print "does not require parentheses"
    Call no_parentheses("deprecated use")
    Debug.Print "of parentheses"
    
End Sub
Task: Copy a string








VB: Sub copystring()
    a = "Hello World!"
    b = a
    a = "I
    Debug.Print b
    Debug.Print a
End Sub
Task: Verify distribution uniformity_Naive








VB: Option Explicit

sub verifydistribution(calledfunction, samples, delta)
	Dim i, n, maxdiff
	
	Dim d : Set d = CreateObject("Scripting.Dictionary")
	wscript.echo "Running """ & calledfunction & """ " & samples & " times..."
	for i = 1 to samples
		Execute "n = " & calledfunction
		d(n) = d(n) + 1
	next
	n = d.Count
	maxdiff = 0
	wscript.echo "Expected average count is " & Int(samples/n) & " across " & n & " buckets."
	for each i in d.Keys
		dim diff : diff = abs(1 - d(i) / (samples/n))
		if diff > maxdiff then maxdiff = diff
		wscript.echo "Bucket " & i & " had " & d(i) & " occurences" _
		& vbTab & " difference from expected=" & FormatPercent(diff, 2)
	next
	wscript.echo "Maximum found variation is " & FormatPercent(maxdiff, 2) _
		& ", desired limit is " & FormatPercent(delta, 2) & "."
	if maxdiff > delta then wscript.echo "Skewed!" else wscript.echo "Smooth!"
end sub
Task: Hofstadter Q sequence








VB: Public Q(100000) As Long
Public Sub HofstadterQ()
    Dim n As Long, smaller As Long
    Q(1) = 1
    Q(2) = 1
    For n = 3 To 100000
        Q(n) = Q(n - Q(n - 1)) + Q(n - Q(n - 2))
        If Q(n) < Q(n - 1) Then smaller = smaller + 1
    Next n
    Debug.Print "First ten terms:"
    For i = 1 To 10
        Debug.Print Q(i);
    Next i
    Debug.print
    Debug.Print "The 1000th term is:"; Q(1000)
    Debug.Print "Number of times smaller:"; smaller
End Sub
Task: Count occurrences of a substring








VB: Public Sub Main() 
  
  Print countSubstring("the three truths", "th") 
  Print countSubstring("ababababab", "abab") 
  Print countSubString("zzzzzzzzzzzzzzz", "z")

End 

Function countSubstring(s As String, search As String) As Integer 

  If s = "" Or search = "" Then Return 0 
  Dim count As Integer = 0, length As Integer = Len(search) 
  For i As Integer = 1 To Len(s) 
    If Mid(s, i, length) = Search Then 
      count += 1 
      i += length - 1 
    End If 
  Next 
  Return count 

End Function
Task: Case-sensitivity of identifiers








VB: Public Sub case_sensitivity()
    
    
    
    Dim DOG As String
    DOG = "Benjamin"
    DOG = "Samba"
    DOG = "Bernie"
    Debug.Print "There is just one dog named " & DOG
End Sub
Task: Sorting algorithms_Shell sort








VB: Sub arrShellSort(ByVal arrData As Variant)
  Dim lngHold, lngGap As Long
  Dim lngCount, lngMin, lngMax As Long
  Dim varItem As Variant
  
  lngMin = LBound(arrData)
  lngMax = UBound(arrData)
  lngGap = lngMin
  Do While (lngGap < lngMax)
    lngGap = 3 * lngGap + 1
  Loop
  Do While (lngGap > 1)
    lngGap = lngGap \ 3
    For lngCount = lngGap + lngMin To lngMax
      varItem = arrData(lngCount)
      lngHold = lngCount
      Do While ((arrData(lngHold - lngGap) > varItem))
        arrData(lngHold) = arrData(lngHold - lngGap)
        lngHold = lngHold - lngGap
        If (lngHold < lngMin + lngGap) Then Exit Do
      Loop
      arrData(lngHold) = varItem
    Next
  Loop
  arrShellSort = arrData
End Sub
Task: Read a specific line from a file








VB: Function read_line(filepath,n)
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.OpenTextFile(filepath,1)
	arrLines = Split(objFile.ReadAll,vbCrLf)
	If UBound(arrLines) >= n-1 Then
		If arrLines(n-1) <> "" Then
			read_line = arrLines(n-1)
		Else
			read_line = "Line " & n & " is null."
		End If
	Else
		read_line = "Line " & n & " does not exist."
	End If
	objFile.Close
	Set objFSO = Nothing
End Function

WScript.Echo read_line("c:\temp\input.txt",7)
Task: URL encoding








VB:   Dim URL As String = "http://foo bar/"
  URL = EncodeURLComponent(URL)
  Print(URL)
Task: Optional parameters








VB: Private Sub optional_parameters(theRange As String, _
        Optional ordering As Integer = 0, _
        Optional column As Integer = 1, _
        Optional reverse As Integer = 1)
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add _
        Key:=Range(theRange).Columns(column), _
        SortOn:=SortOnValues, _
        Order:=reverse, _
        DataOption:=ordering 
    With ActiveSheet.Sort
        .SetRange Range(theRange)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Public Sub main()
    
    
    
    
    
    
    
    
    
    optional_parameters theRange:="A1:C4", ordering:=1, column:=2, reverse:=1
End Sub
Task: Odd word problem








VB: Private Function OddWordFirst(W As String) As String
Dim i As Integer, count As Integer, l As Integer, flag As Boolean, temp As String
   count = 1
   Do
      flag = Not flag
      l = FindNextPunct(i, W) - count + 1
      If flag Then
         temp = temp & ExtractWord(W, count, l)
      Else
         temp = temp & ReverseWord(W, count, l)
      End If
   Loop While count < Len(W)
   OddWordFirst = temp
End Function

Private Function FindNextPunct(d As Integer, W As String) As Integer
Const PUNCT As String = ",;:."
   Do
      d = d + 1
   Loop While InStr(PUNCT, Mid(W, d, 1)) = 0
   FindNextPunct = d
End Function

Private Function ExtractWord(W As String, c As Integer, i As Integer) As String
   ExtractWord = Mid(W, c, i)
   c = c + Len(ExtractWord)
End Function

Private Function ReverseWord(W As String, c As Integer, i As Integer) As String
Dim temp As String, sep As String
   temp = Left(Mid(W, c, i), Len(Mid(W, c, i)) - 1)
   sep = Right(Mid(W, c, i), 1)
   ReverseWord = StrReverse(temp) & sep
   c = c + Len(ReverseWord)
End Function
Task: Self-describing numbers








VB: Function IsSelfDescribing(n)
	IsSelfDescribing = False
	Set digit = CreateObject("Scripting.Dictionary")
	For i = 1 To Len(n)
		k = Mid(n,i,1)
		If digit.Exists(k) Then
			digit.Item(k) = digit.Item(k) + 1
		Else
			digit.Add k,1
		End If	
	Next
	c = 0
	For j = 0 To Len(n)-1
		l = Mid(n,j+1,1)
		If digit.Exists(CStr(j)) Then
			If digit.Item(CStr(j)) = CInt(l) Then
				c = c + 1
			End If
		ElseIf l = 0 Then
			c = c + 1
		Else
			Exit For
		End If
	Next
	If c = Len(n) Then
		IsSelfDescribing = True
	End If
End Function


start_time = Now
s = ""
For m = 1 To 100000000
	If 	IsSelfDescribing(m) Then
		WScript.StdOut.WriteLine m
	End If
Next
end_time = Now
WScript.StdOut.WriteLine "Elapse Time: " & DateDiff("s",start_time,end_time) & " seconds"
Task: Function definition








VB: Function Multiply(a As Integer, b As Integer) As Integer
  Return a * b
End Function
Task: Sorting algorithms_Bead sort








VB: Option Base 1

Private Function sq_add(arr As Variant, x As Double) As Variant
    Dim res() As Variant
    ReDim res(UBound(arr))
    For i = 1 To UBound(arr)
        res(i) = arr(i) + x
    Next i
    sq_add = res
End Function

Private Function beadsort(ByVal a As Variant) As Variant
    Dim poles() As Variant
    ReDim poles(WorksheetFunction.Max(a))
    For i = 1 To UBound(a)
        For j = 1 To a(i)
            poles(j) = poles(j) + 1
        Next j
    Next i
    For j = 1 To UBound(a)
        a(j) = 0
    Next j
    For i = 1 To UBound(poles)
        For j = 1 To poles(i)
            a(j) = a(j) + 1
        Next j
    Next i
    beadsort = a
End Function
 
Public Sub main()
    Debug.Print Join(beadsort([{5, 3, 1, 7, 4, 1, 1, 20}]), ", ")
End Sub
Task: Playing cards








VB: suite$ = "CDHS"                 #Club, Diamond, Heart, Spade
card$  = "A23456789TJQK"        #Cards Ace to King
card   = 0

dim n(55)                       #make ordered deck
for i = 1 to 52                 # of 52 cards
    n[i] = i
next i

for i = 1 to 52 * 3             #shuffle deck 3 times
    i1    = int(rand * 52) + 1
    i2    = int(rand * 52) + 1
    h2    = n[i1]
    n[i1] = n[i2]
    n[i2] = h2
next i

for hand = 1 to 4               #4 hands
    for deal = 1 to 13            #deal each 13 cards
        card += 1               #next card in deck
        s = (n[card] mod 4)  + 1    #determine suite
        c = (n[card] mod 13) + 1    #determine card
        print mid(card$,c,1);mid(suite$,s,1);" ";  #show the card
    next deal
    print
next hand
end

function word$(sr$, wn, delim$)
    j = wn
    if j = 0 then j += 1
    res$ = "" : s$ = sr$ : d$ = delim$
    if d$ = "" then d$ = " "
    sd = length(d$) : sl = length(s$)
    while true
        n = instr(s$,d$) : j -= 1
        if j = 0 then
            if n=0 then res$=s$ else res$=mid(s$,1,n-1)
            return res$
        end if
        if n = 0 then return res$
        if n = sl - sd then res$ = "" : return res$
        sl2 = sl-n : s$ = mid(s$,n+1,sl2) : sl = sl2
    end while
    return res$
end function
Task: Color of a screen pixel








VB:   Private Function GetPixelColor(ByVal Location As Point) As Color

    Dim b As New Bitmap(1, 1)
    Dim g As Graphics = Graphics.FromImage(b)

    g.CopyFromScreen(Location, Point.Empty, New Size(1, 1))

    Return b.GetPixel(0, 0)

  End Function
Task: Sierpinski triangle_Graphical








VB: option explicit


const pi180= 0.01745329251994329576923690768489 
const pi=3.1415926535897932384626433832795 
class turtle
   
   dim fso
   dim fn
   dim svg
   
   dim iang  
   dim ori   
   dim incr
   dim pdown
   dim clr
   dim x
   dim y

   public property let orient(n):ori = n*pi180 :end property
   public property let iangle(n):iang= n*pi180 :end property
   public sub pd() : pdown=true: end sub 
   public sub pu()  :pdown=FALSE :end sub 
   
   public sub rt(i)  
     ori=ori - i*iang:
     
   end sub 
   public sub lt(i):  
     ori=(ori + i*iang) 
     
   end sub
   
   public sub bw(l)
      x= x+ cos(ori+pi)*l*incr
      y= y+ sin(ori+pi)*l*incr
     
   end sub 
   
   public sub fw(l)
      dim x1,y1 
      x1=x + cos(ori)*l*incr
      y1=y + sin(ori)*l*incr
      if pdown then line x,y,x1,y1
      x=x1:y=y1
   end sub
   
   Private Sub Class_Initialize() 
      setlocale "us"    
      initsvg
      x=400:y=400:incr=100
      ori=90*pi180
      iang=90*pi180
      clr=0
      pdown=true
   end sub
   
   Private Sub Class_Terminate()   
      disply
   end sub
   
   private sub line (x,y,x1,y1)
      svg.WriteLine "<line x1=""" & x & """ y1= """& y & """ x2=""" & x1& """ y2=""" & y1 & """/>"
   end sub 

   private sub disply()
       dim shell
       svg.WriteLine "</svg></body></html>"
       svg.close
       Set shell = CreateObject("Shell.Application") 
       shell.ShellExecute fn,1,False
   end sub 

   private sub initsvg()
     dim scriptpath
     Set fso = CreateObject ("Scripting.Filesystemobject")
     ScriptPath= Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
     fn=Scriptpath & "SIERP.HTML"
     Set svg = fso.CreateTextFile(fn,True)
     if SVG IS nothing then wscript.echo "Can
     svg.WriteLine "<!DOCTYPE html>" &vbcrlf & "<html>" &vbcrlf & "<head>"
     svg.writeline "<style>" & vbcrlf & "line {stroke:rgb(255,0,0);stroke-width:.5}" &vbcrlf &"</style>"
     svg.writeline "</head>"&vbcrlf & "<body>"
     svg.WriteLine "<svg xmlns=""http://www.w3.org/2000/svg"" width=""800"" height=""800"" viewBox=""0 0 800 800"">" 
   end sub 
end class


sub sier(lev,lgth)
   dim i
   
   if lev=1 then  
     for i=1 to 3
       x.fw lgth 
       x.lt 2
     next  
   else
      sier lev-1,lgth\2
      x.fw lgth\2
      sier lev-1,lgth\2
      x.bw lgth\2
      x.lt 1
      x.fw lgth\2
      x.rt 1
      sier lev-1,lgth\2 
      x.lt 1
      x.bw lgth\2
      x.rt 1
    end if  
end sub
     
dim x
set x=new turtle
x.iangle=60
x.orient=0
x.incr=10
x.x=100:x.y=100

sier 7,64
set x=nothing
Task: Straddling checkerboard








VB: 

Function encrypt(ByVal originalText, ByVal alphabet, blank1, blank2)
  Const notEscape = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ."
  Dim i, j, curChar, escChar, outText
  Dim cipher  
  Set cipher = CreateObject("Scripting.Dictionary")
  
  alphabet = UCase(alphabet) : j = 0
  For i = 1 To 28
    curChar = Mid(alphabet, i, 1)
    Select Case True
      Case i>= 1 And i<= 8
        If j = blank1 Or j = blank2 Then j = j + 1  
		cipher.Add curChar, CStr(j)
        j = j + 1
      Case i>= 9 And i<=18
		cipher.Add curChar, CStr(blank1) & CStr(i -  9)
      Case i>=19 And i<=28
		cipher.Add curChar, CStr(blank2) & CStr(i - 19)
    End Select 
    If InStr(notEscape, curChar) = 0 Then
      escChar = curChar
      
    End If
  Next 
  For i = 0 To 9: cipher.Add CStr(i), cipher(escChar) & CStr(i): Next 
  
  originalText = UCase(originalText)
  For i = 1 To Len(originalText)
    outText = outText & cipher(Mid(originalText, i, 1))
  Next 
  encrypt=outText
End Function 
 
Function decrypt(ByVal cipherText, ByVal alphabet, blank1, blank2)
  Const notEscape = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ."
  Dim i, j, curChar, escCipher, outText
  Dim cipher  
  Set cipher = CreateObject("Scripting.Dictionary")
  
  alphabet = UCase(alphabet) : j = 0
  For i = 1 To 28
    curChar = Mid(alphabet, i, 1)
    Select Case True
      Case i>= 1 And i<= 8
        If j = blank1 Or j = blank2 Then j = j + 1  
		cipher.Add CStr(j),curChar
        j = j + 1
      Case i>= 9 And i<=18
        cipher.Add CStr(blank1) & CStr(i -  9), curChar
      Case i>=19 And i<=28
        cipher.Add CStr(blank2) & CStr(i - 19), curChar
    End Select 
    If InStr(notEscape, curChar) = 0 Then
      
      arrayKeys=cipher.keys
      escCipher = arrayKeys(cipher.count-1)
      
    End If
  Next 
  For i = 0 To 9: cipher.Add escCipher & CStr(i), CStr(i): Next 
  
  i = 1
  Do While i <= Len(cipherText)
    curChar = Mid(cipherText, i, 1)
    If curChar = CStr(blank1) Or curChar = CStr(blank2) Then
      curChar = Mid(cipherText, i, 2)
      If curChar = escCipher Then curChar = Mid(cipherText, i, 3)
    End If 
    outText = outText & cipher(curChar)
    i = i + Len(curChar)
  Loop 
  decrypt=outText
End Function 
 
  message = "One night-it was on the twentieth of March, 1888-I was returning"
  cipher = "HOLMESRTABCDFGIJKNPQUVWXYZ./"
  
  
  
  
  Buffer=Buffer & "Original: " & message & vbCrlf 
  encoded = encrypt(message, cipher, 3, 7)
  Buffer=Buffer &  "encoded: " & encoded & vbCrlf
  decoded = decrypt(encoded, cipher, 3, 7)
  Buffer=Buffer &  "decoded: " & decoded & vbCrlf
  Wscript.Echo Buffer
Task: Parse an IP Address








VB: Function parse_ip(addr)
    
    Set ipv4_pattern = New RegExp
    ipv4_pattern.Global = True
    ipv4_pattern.Pattern = "(\d{1,3}\.){3}\d{1,3}"
    
    Set ipv6_pattern = New RegExp
    ipv6_pattern.Global = True
    ipv6_pattern.Pattern = "([0-9a-fA-F]{0,4}:){2}[0-9a-fA-F]{0,4}"
    
    If ipv4_pattern.Test(addr) Then
        port = Split(addr,":")
        octet = Split(port(0),".")
        ipv4_hex = ""
        For i = 0 To UBound(octet)
            If octet(i) <= 255 And octet(i) >= 0 Then
                ipv4_hex = ipv4_hex & Right("0" & Hex(octet(i)),2)
            Else
                ipv4_hex = "Erroneous Address"
                Exit For
            End If 
        Next
        parse_ip = "Test Case: " & addr & vbCrLf &_
                   "Address: " & ipv4_hex & vbCrLf
        If UBound(port) = 1 Then
            If port(1) <= 65535 And port(1) >= 0 Then
                parse_ip = parse_ip & "Port: " & port(1) & vbCrLf
            Else
                parse_ip = parse_ip & "Port: Invalid" & vbCrLf
            End If
        End If
    End If
    
    If ipv6_pattern.Test(addr) Then
        parse_ip = "Test Case: " & addr & vbCrLf
        port_v6 = "Port: "
        ipv6_hex = ""
        
        If InStr(1,addr,"[") Then
            
            port_v6 = port_v6 & Mid(addr,InStrRev(addr,"]")+2,Len(addr)-Len(Mid(addr,1,InStrRev(addr,"]")+1)))
            
            addr = Mid(addr,InStrRev(addr,"[")+1,InStrRev(addr,"]")-(InStrRev(addr,"[")+1))
        End If
        word = Split(addr,":")
        word_count = 0
        For i = 0 To UBound(word)
            If word(i) = "" Then
                If i < UBound(word) Then
                    If Int((7-(i+1))/2) = 1 Then
                        k = 1
                    ElseIf UBound(word) < 6 Then
                        k = Int((7-(i+1))/2)
                    ElseIf UBound(word) >= 6 Then
                        k = Int((7-(i+1))/2)-1
                    End If
                    For j = 0 To k
                        ipv6_hex = ipv6_hex & "0000"
                        word_count = word_count + 1
                    Next
                Else
                    For j = 0 To (7-word_count)
                        ipv6_hex = ipv6_hex & "0000"
                    Next
                End If
            Else
                ipv6_hex = ipv6_hex & Right("0000" & word(i),4)
                word_count = word_count + 1
            End If
        Next
        parse_ip = parse_ip & "Address: " & ipv6_hex &_
                vbCrLf & port_v6 & vbCrLf
    End If
    
    If ipv4_pattern.Test(addr) = False And ipv6_pattern.Test(addr) = False Then
        parse_ip = "Test Case: " & addr & vbCrLf &_
                   "Address: Invalid Address" & vbCrLf
    End If
End Function


ip_arr = Array("127.0.0.1","127.0.0.1:80","::1",_
    "[::1]:80","2605:2700:0:3::4713:93e3","[2605:2700:0:3::4713:93e3]:80","RosettaCode")

For n = 0 To UBound(ip_arr)
    WScript.StdOut.Write parse_ip(ip_arr(n)) & vbCrLf
Next
Task: Type detection








VB: 
 


#macro typeDetector(arg)
    #if TypeOf(foo) = TypeOf(Byte)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(Short)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(Integer)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(LongInt)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(UByte)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(UShort)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(UInteger)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(ULongInt)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(Single)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(Double)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(integer ptr)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(byte ptr)
      Print arg; " -> It
    #elseif TypeOf(foo) = TypeOf(String)
      Print arg; " -> It
    #endif
#endmacro




Var foo = "Rosetta Code"     

typeDetector (foo)
Sleep