Thursday, February 28, 2013

VBScript for compressing files in a folder and send on FTP

This is a simple vbscript compression script. works flawlessly on text files even bigger than 15GB.
We have a SSIS data generation package installed on our DB server which generates huge data files for data mining operations for current year, current month. The below scripts are doing the rest; compress the files and FTP to the data mining server location.
 
'======================================================
' Function : Zip datamart CSV, CTL files to local server for archive purposes.
'======================================================
Function WindowsZip(sFile, sZipFile, szPath, szDate)
  Set oZipShell = CreateObject("WScript.Shell") 
  Set oZipFSO = CreateObject("Scripting.FileSystemObject")
  Set LogFile = oZipFSO.CreateTextFile(szPath & "\Logs\log_" & szDate & ".log", true) 
 LogFile.WriteLine("=======================================")
  LogFile.WriteLine(Now & " - Compressing CSV file - Starting...")
 LogFile.WriteLine("=======================================")
  If Not oZipFSO.FileExists(sZipFile) Then
    NewZip(sZipFile)
  End If
  Set oZipApp = CreateObject("Shell.Application")
  Set source = oZipApp.NameSpace(sFile).Items
  sZipFileCount = oZipApp.NameSpace(sZipFile).items.Count
oZipApp.NameSpace(sZipFile).Copyhere source
LogFile.WriteLine(sZipFile & " - Compressing -")
'Keep script waiting until Compressing is done
On Error Resume Next
sLoop = 0
Do Until sZipFileCount < oZipApp.NameSpace(sZipFile).Items.Count
 Wscript.Sleep(100)
 sLoop = sLoop + 1
Loop
On Error GoTo 0
  LogFile.WriteLine(sZipFile & " - Successfully compressed -")
  LogFile.WriteBlankLines 1
  LogFile.Close
  Set LogFile = Nothing
  Set oZipShell = Nothing
  Set oZipFSO = Nothing 
End Function
Sub NewZip(sNewZip)
  Set oNewZipFSO = CreateObject("Scripting.FileSystemObject")
  Set oNewZipFile = oNewZipFSO.CreateTextFile(sNewZip)
  oNewZipFile.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
  oNewZipFile.Close
  Set oNewZipFSO = Nothing
  Wscript.Sleep(500)
End Sub
'======================================================
' Function : Upload datamart CSV, CTL files to MTMS FTP server.
'======================================================
Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath, szPath, szDate, szYear, szMonth)
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")
  Set LogFile = oFTPScriptFSO.OpenTextFile(szPath & "\Logs\log_" & szDate & ".log", 8)  
LogFile.WriteLine("========================================")
  LogFile.WriteLine(Now & " - Sending CSV file on FTP - Starting...")
LogFile.WriteLine("========================================")
  sRemotePath = Trim(sRemotePath)
  sLocalFile = Trim(sLocalFile)  
  'Check to ensure that a remote path was
  'passed. If it's blank then pass a "\"
  If Len(sRemotePath) = 0 Then
    sRemotePath = "\"
  End If
  If InStr(sLocalFile, "*") Then
    If InStr(sLocalFile, " ") Then
      FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & "space." & vbCRLF
      FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."
 LogFile.WriteLine(FTPUpload)
      Exit Function
    End If
  ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
    'nothing to upload
    FTPUpload = "Error: File Not Found."
LogFile.WriteLine(sLocalFile & FTPUpload)
    Exit Function
  End If
  '--------END Path Checks---------
  
  'build input file for ftp command
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  sFTPScript = sFTPScript & "prompt " & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "lcd " & szPath & vbCRLF
  sFTPScript = sFTPScript & "mput " & sLocalFile & vbCRLF
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
  sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName

  'Write the input file for the ftp command
  'to a temporary file.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing  
  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & " > " & sFTPResults, 0, TRUE
  Wscript.Sleep 1000
  'Check results of transfer.
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, FailIfNotExist, OpenAsDefault)
  'sResults = fFTPResults.ReadAll
  Do Until fFTPResults.AtEndOfStream
    sResults = sResults & vbCRLF & fFTPResults.ReadLine
  Loop
  fFTPResults.Close
  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  oFTPScriptFSO.DeleteFile (sFTPResults)
  If InStr(sResults, "226 Transfer complete.") > 0 Then
    FTPUpload = "226 Transfer complete."
  ElseIf InStr(sResults, "File not found") > 0 Then
    FTPUpload = "Error: File Not Found"
  ElseIf InStr(sResults, "cannot log in.") > 0 Then
    FTPUpload = "Error: Login Failed."
  Else
    FTPUpload = sResults & "Error: Unknown."
  End If
  LogFile.WriteLine(FTPUpload)
  LogFile.WriteBlankLines 1
  LogFile.Close
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
  Set LogFile = Nothing
End Function

Dim dtTemp, szMonth, szDayName, szDay, szYear, inFilename, outFilename, szPath, szDate
dtTemp = Date
'Get the 2 digit month. VBScript does not include a function for this
if (len(CStr(Month(dtTemp))) < 2) then
szMonth = "0" & CStr(Month(dtTemp))
else
szMonth = CStr(Month(dtTemp))
end if
if (len(CStr(Day(dtTemp))) < 2) then
szDay = "0" & CStr(Day(dtTemp))
else
szDay = CStr(Day(dtTemp))
end if
szYear = Year(dtTemp)
szPath = "D:\FILES"
szDate = szYear & szMonth & szDay
inFilename = szPath & "\" & szYear & "\" & szMonth
outFilename = szPath & "\Archive\COMPRESSED" & ".ZIP"
Wscript.Echo WindowsZip(inFilename, outFilename, szPath, szDate)
 Wscript.Echo FTPUpload("xx.xx.xx.xx", "userid", "password", outFilename, "REMOTEPATH", szPath, szDate, szYear, szMonth)

Save the above script as compress_ftp.vbs, and run it on task scheduler with cscript. For the total file size around 20GB, this process will take around 1 hour.