Submitted By: Anonymous Submission

FTPs files to a particular folder. We use this for batch jobs for IBM mainframes running under z/VM. Jobs to be submitted are to be copied to p:\flex\rdr, and have an extension of either MVS or VSE, depending on where the job is to run.

Visual Basic
Edit|Remove
Dim strRDRPath
Dim strComputer
Dim FSO
Dim WSH

strRDRPath = "p:\flex\rdr\"
strComputer = "."

Set FSO = CreateObject("Scripting.FileSystemObject")

Set WSH = CreateObject("WScript.Shell")


' Set up to monitor strRDRPath (except w/4 "\" where each goes)
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\.\root\cimv2")

' Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
'     ("SELECT * FROM __InstanceCreationEvent WITHIN 3 WHERE " _
'         & "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
'             &  (("TargetInstance.GroupComponent= 'Win32_Directory.Name=""p:\\\\flex\\\\rdr\\\\vse""'")) & " Or " _
'             & ("TargetInstance.GroupComponent= 'Win32_Directory.Name=""p:\\\\flex\\\\rdr\\\\mvs""'"))


Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
    ("SELECT * FROM __InstanceCreationEvent WITHIN 3 WHERE " _
        & "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
            & "TargetInstance.GroupComponent= " _
                & "'Win32_Directory.Name=""p:\\\\flex\\\\rdr""'")

Do
    Set objLatestEvent = colMonitoredEvents.NextEvent
    WScript.Echo objLatestEvent.TargetInstance.PartComponent

' Get filename just copied to this dir:
    Obj = Trim(objLatestEvent.TargetInstance.PartComponent)

    FNPos = InStr(Obj, "p:\\flex\\rdr\\") + 15
    ObjLen = Len(Obj)
    FNLen = ObjLen - FNPos

    WScript.Echo "The file name is at position " & FNPos & ", length = " & FNLen

    If FNPos > 0 Then FLName = Mid(Obj, FNPos, FNLen)
    WScript.Echo "The " & FLName & " file was just created"

    OpSys = UCase(Right(FLName, 3))
    If OpSys <> "MVS" And OpSys <> "VSE" Then
       WScript.Echo FLName & " is not valid--file ext not = 'VSE' or 'MVS'"
    Else
       SubJob OpSys, FLName
       End If

    ' Now, clean up the file:
    WScript.Echo "Now deleting " & strRDRPath & FLName
    FSO.DeleteFile strRDRPath & FLName, "True"

    Loop

'End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function SubJob(OpSys, fn)

TRANSFER_TYPE_ASCII = 1
TRANSFER_TYPE_BINARY = 2

Dim objFTP
Dim strMsg

Dim UID
Dim Pwd

UID = Trim(OpSys) & "RDR"
Pwd = Trim(OpSys)

'create reference to object
Set objFTP = CreateObject("NIBLACK.ASPFTP")

'set the properties for the connection
objFTP.sServerName = "VM"
objFTP.sUserID = UID
objFTP.sPassword = Pwd

'connect to the host
If objFTP.bConnect Then
    'set the properties for the get function
    objFTP.lTransferType = TRANSFER_TYPE_ASCII

    objFTP.bSetCurrentDir (UID & ".RDR")

    'now put the file
    If objFTP.bPutFile(strRDRPath & fn, fn) Then
        'put was successful
        WScript.Echo "Put Successful!"
    Else
        'put failed...let user know
        WScript.Echo "Put Failed: " & objFTP.sError & " - " & objFTP.sErrorDesc
    End If
Else
    'connection failed...let user know
    WScript.Echo "Connection Failed: " & objFTP.sError
End If

'clean up...
Set objFTP = Nothing
End Function