Enterprise Software Solutions 

  Jump to: DW University, Employment

Notes

Steps

1. Download the executable or recompile the project using the source code.
2. In SQL Server DTS, create a Win32 task like this:

'*********************************************************************************************
'*********************************************************************************************
'FTP program to get, put, and delete via FTP
'accepts command line parms
'USAGE:
' 6 pipe delimited parms are required:
' 1)Action
' in('GET','PUT','DELETE')
' 2)ServerName
' 3)UserName
' 4)Password
' 5)SourceDirectory
' 6)Filename
' 2 parms are optional:
' 1)DestinationDirectory
' 2)FileTransferType
' in('ASCII','BINARY')
'Used:
' CommandFTP.exe GET|ServerName|UserName|Password|SourceDirectory|FileName|DestinationDirectory|FileTransferType

'Example:
' CommandFTP.exe GET|sourceDomain.com|UserName|Password|/./files/data|FileName.dat|\\ServerName\Path\|ASCII

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


'holds command line parms
Public Type CommandLineParms
Action As String
ServerName As String
UserName As String
Password As String
SourceDirectory As String
FileName As String
DestinationDirectory As String
FileTransferType As String
End Type

'ftp actions
Public Const ActionGetFTP As String = "GET"
Public Const ActionPutFTP As String = "PUT"
Public Const ActionDeleteFTP As String = "DELETE"

'file transfer type
Public Const FileTransferTypeASCII As String = "ASCII"
Public Const FileTransferTypeBinary As String = "BINARY"

Option Explicit


Public Sub Main()
Dim Parms As CommandLineParms
Dim lFileTransferType As Long

'Retrieve parameters from call
Call GetCommandLineParms(Parms)

'validate the FTP file transfer type parm
Select Case UCase(Parms.FileTransferType)
Case ""
'default is ASCII)
lFileTransferType = FTP_TRANSFER_TYPE_ASCII
Case FileTransferTypeASCII
'Set ASCII
lFileTransferType = FTP_TRANSFER_TYPE_ASCII
Case FileTransferTypeBinary
'set Binary
lFileTransferType = FTP_TRANSFER_TYPE_BINARY
Case Else
'invalid file transfer type
Call Err.Raise(5000, "Main()", "File Transfer Type must be 'ASCII' or 'Binary'")
End Select

'validate the FTP action parm
Select Case UCase(Parms.Action)
Case ActionGetFTP
'FTP Get
Call GetFTP(Parms.ServerName, Parms.UserName, Parms.Password, _
Parms.SourceDirectory, Parms.DestinationDirectory, _
Parms.FileName, lFileTransferType)
Case ActionPutFTP
'FTP Put
Call PutFTP(Parms.ServerName, Parms.UserName, Parms.Password, _
Parms.SourceDirectory, Parms.DestinationDirectory, _
Parms.FileName, lFileTransferType)
Case ActionDeleteFTP
'FTP Delete
Call DeleteFTP(Parms.ServerName, Parms.UserName, Parms.Password, _
Parms.SourceDirectory, Parms.FileName)
Case Else
'invalid Action Type
Call Err.Raise(5000, "Main()", "FTP Action must be 'GET', 'PUT', or 'DELETE'")
End Select

'leave
End
End Sub

Private Sub GetCommandLineParms(Parms As CommandLineParms)
Dim ArgArray() As String

'Get command line parms
LogEvent "Get command line parms: " & CStr(Command())
ArgArray() = CArray(Command())
'check number of parms
If UBound(ArgArray) < 5 Then
Call Err.Raise(5000, "GetCommandLineParms()", "6 pipe delimited parms are required: " _
& "1)Action in('GET','PUT','DELETE') -- 2)ServerName 3)UserName 4)Password " _
& "5)SourceDirectory 6)Filename " _
& "--- 2 parms are optional: 1)DestinationDirectory " _
& "2)FileTransferType in('ASCII','BINARY')")
End If

Parms.Action = Trim(ArgArray(0))
Parms.ServerName = Trim(ArgArray(1))
Parms.UserName = Trim(ArgArray(2))
Parms.Password = Trim(ArgArray(3))
Parms.SourceDirectory = Trim(ArgArray(4))
Parms.FileName = Trim(ArgArray(5))
'DestinationDirectory Arg is optional (because of delete option)
If UBound(ArgArray) >= 6 Then
Parms.DestinationDirectory = Trim(ArgArray(6))
End If
'FileTransferType Arg is optional
If UBound(ArgArray) >= 7 Then
Parms.FileTransferType = Trim(ArgArray(7))
End If
End Sub


'******************************************************************************
'******************************************************************************
'Get files via FTP
'******************************************************************************
'******************************************************************************
'Get files via FTP
Public Sub GetFTP( _
strServerName As String _
, strUserName As String _
, strPassword As String _
, strRemoteSourceDirectory As String _
, strLocalDestinationDirectory As String _
, strFileName As String _
, Optional lFileTransferType As Long = FTP_TRANSFER_TYPE_ASCII)
Dim bRet As Boolean
Dim hOpen As Long
Dim hConnection As Long
Dim lPassiveFlag As Long


'**************************
'Set connection properties
'**************************
lPassiveFlag = INTERNET_FLAG_PASSIVE 'passive true
'lPassiveFlag = 0 'passive false
lFileTransferType = FTP_TRANSFER_TYPE_ASCII
'lFileTransferType = FTP_TRANSFER_TYPE_BINARY
'**************************
'**************************
'**************************


'open Connection
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen = 0 Then
Call Err.Raise(Err.LastDllError, "InternetOpen" _
, "InterNetOpen (" & strFileName & ") Failed!")
End If
hConnection = InternetConnect(hOpen, strServerName, INTERNET_INVALID_PORT_NUMBER, _
strUserName, strPassword, INTERNET_SERVICE_FTP, lPassiveFlag, 0)
If hConnection = 0 Then
Call Err.Raise(Err.LastDllError, "InternetOpen" _
, "InternetConnect (" & strFileName & ") Failed!")
End If

'change remote directory
bRet = FtpSetCurrentDirectory(hConnection, strRemoteSourceDirectory)
If bRet = False Then
Call Err.Raise(Err.LastDllError, "FtpSetCurrentDirectory" _
, "FtpSetCurrentDirectory (" & strFileName & ") Failed!")
End If

'FTP get
bRet = FtpGetFile(hConnection _
, strFileName _
, strLocalDestinationDirectory & "\" & strFileName _
, False _
, INTERNET_FLAG_RELOAD _
, lFileTransferType, 0)
If bRet = False Then
Call Err.Raise(Err.LastDllError _
, "FtpGetFile", "FtpGetFile (" & strFileName & ") Failed!")
End If

ExitCleanup:
'Close Connection
If hConnection <> 0 Then
InternetCloseHandle hConnection
hConnection = 0
End If
If hOpen <> 0 Then
InternetCloseHandle (hOpen)
hOpen = 0
End If
End Sub

'******************************************************************************
'******************************************************************************
'Put files via FTP
'******************************************************************************
'******************************************************************************
'Put files via FTP
Public Sub PutFTP( _
strServerName As String _
, strUserName As String _
, strPassword As String _
, strLocalSourceDirectory As String _
, strRemoteDestinationDirectory As String _
, strFileName As String _
, Optional lFileTransferType As Long = FTP_TRANSFER_TYPE_ASCII)
Dim bRet As Boolean
Dim hOpen As Long
Dim hConnection As Long
Dim lPassiveFlag As Long

'Set connection properties
lPassiveFlag = INTERNET_FLAG_PASSIVE 'passive true
lFileTransferType = FTP_TRANSFER_TYPE_ASCII
'lFileTransferType = FTP_TRANSFER_TYPE_BINARY
'**************************
'**************************
'**************************


'open Connection
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen = 0 Then
Call Err.Raise(Err.LastDllError, "InternetOpen" _
, "InterNetOpen (" & strFileName & ") Failed!")
End If
hConnection = InternetConnect(hOpen, strServerName, INTERNET_INVALID_PORT_NUMBER, _
strUserName, strPassword, INTERNET_SERVICE_FTP, lPassiveFlag, 0)
If hConnection = 0 Then
Call Err.Raise(Err.LastDllError, "InternetOpen" _
, "InternetConnect (" & strFileName & ") Failed!")
End If

'change remote directory
bRet = FtpSetCurrentDirectory(hConnection, strRemoteDestinationDirectory)
If bRet = False Then
Call Err.Raise(Err.LastDllError, "FtpSetCurrentDirectory" _
, "FtpSetCurrentDirectory (" & strFileName & ") Failed!")
End If

'FTP put
bRet = FtpPutFile(hConnection _
, strLocalSourceDirectory & "\" & strFileName _
, strFileName _
, lFileTransferType, 0)
If bRet = False Then
Call Err.Raise(Err.LastDllError, "FtpPutFile" _
, "FtpPutFile (" & strFileName & ") Failed!")
End If

ExitCleanup:
'Close Connection
If hConnection <> 0 Then
InternetCloseHandle hConnection
hConnection = 0
End If
If hOpen <> 0 Then
InternetCloseHandle (hOpen)
hOpen = 0
End If
End Sub

'******************************************************************************
'******************************************************************************
'Delete the files
'******************************************************************************
'******************************************************************************
'Delete the files
Public Sub DeleteFTP( _
strServerName As String _
, strUserName As String _
, strPassword As String _
, strRemoteDestinationDirectory As String _
, strFileName As String)
Dim bRet As Boolean
Dim hOpen As Long
Dim hConnection As Long
Dim lPassiveFlag As Long
Dim lFileTransferType As Long


'**************************
'Set connection properties
'**************************
lPassiveFlag = INTERNET_FLAG_PASSIVE 'passive true
'lPassiveFlag = 0 'passive false
lFileTransferType = FTP_TRANSFER_TYPE_ASCII
'lFileTransferType = FTP_TRANSFER_TYPE_BINARY
'**************************
'**************************
'**************************


'open Connection
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen = 0 Then
Call Err.Raise(Err.LastDllError, "InternetOpen" _
, "InterNetOpen (" & strFileName & ") Failed!")
End If
hConnection = InternetConnect(hOpen, strServerName, INTERNET_INVALID_PORT_NUMBER, _
strUserName, strPassword, INTERNET_SERVICE_FTP, lPassiveFlag, 0)
If hConnection = 0 Then
Call Err.Raise(Err.LastDllError, "InternetOpen" _
, "InternetConnect (" & strFileName & ") Failed!")
End If

'change remote directory
bRet = FtpSetCurrentDirectory(hConnection, strRemoteDestinationDirectory)
If bRet = False Then
Call Err.Raise(Err.LastDllError, "FtpSetCurrentDirectory" _
, "FtpSetCurrentDirectory (" & strFileName & ") Failed!")
End If

'FTP Delete
bRet = FtpDeleteFile(hConnection, strFileName)
If bRet = False Then
Call Err.Raise(Err.LastDllError, "FtpDeleteFile" _
, "FtpDeleteFile (" & strFileName & ") Failed!")
End If


ExitCleanup:
'Close Connection
If hConnection <> 0 Then
InternetCloseHandle hConnection
hConnection = 0
End If
If hOpen <> 0 Then
InternetCloseHandle (hOpen)
hOpen = 0
End If
End Sub




Public Sub junk()
Debug.Print "6 pipe delimited parms are required: " _
& "1)Action in('GET','PUT','DELETE') -- 2)ServerName 3)UserName 4)Password " _
& "5)SourceDirectory 6)Filename " _
& "--- 2 parms are optional: 1)DestinationDirectory " _
& "2)FileTransferType in('ASCII','BINARY')"
End Sub

[ Home ] [ Up ]

Send mail to Webmaster@ESScorporation.com with questions or comments about this web site.
Copyright © 2004 Enterprise Software Solutions, Inc.
Last modified: July 29, 2004