Integrate Quality Center with Fitnesse

I had a hard time trying to figure this out , so here are the steps for the basic integration of these two tools :
The same logic can be used to integrate Quality center and any open source tool:

1. Set up a VAPI-XP-TEST in quality center that will store the script and the logic to run the same.
2. The script would then invoke the opensource tool , in our case Fitnesse from test lab in QC.
3. Once the test is complete we would do two things
1. Report a Pass/Fail for the test
2. Upload the results that are generated by the Fitnesse tool into QC

Here is the cod e that you need to place in the QC VAPI-XP-TEST:

' FitNesse.SuiteAcceptanceTests.SuiteWidgetTests.SetUpLinkTest [VBScript]
' Created by Quality Center
' ====================================================

' ----------------------------------------------------
' Main Test Function
' Debug - Boolean. Equals to false if running in [Test Mode] : reporting to Quality Center
' CurrentTestSet - [OTA COM Library].TestSet.
' CurrentTSTest - [OTA COM Library].TSTest.
' CurrentRun - [OTA COM Library].Run.
' ----------------------------------------------------
Sub Test_Main(Debug, CurrentTestSet, CurrentTSTest, CurrentRun)
  TDOutput.Clear
   '***************** VARIABLES TO BE MODIFIED **************************
  Dim strFITDatabase : strFITDatabase = "FIT"
  Dim strFITUsername : strFITUsername = "Aditya"
  Dim strFIFITassword : strFIFITassword = "pass"
  Dim strFIFITroject : strFIFITroject = "Common"
  Dim strFITTestScriptName : strFITTestScriptName = CurrentTSTest.TestName
  Dim strResultsDirectory :  strResultsDirectory = "C:\Documents and Settings\Desktop\"
  '***********************************************************************************************
  Dim WshShell, objExecObject, strOutput
  Dim strCommand, strTestTypeCommand, strRes
  Dim strTestName
  'Now setup some variables to handle to test results
  Dim strMacroName : strMacroName = "ExtractResultsFromFIT"
  Dim strExpectedResultsPath
  Dim strTimeStamp
  Dim strTemp
  'setup the timestamp in YYYYMMDD_HHMM format
  'get the year
  strTimeStamp = year(now())
  'get the month
  strTemp = month(now())
  if len(strTemp) = 1 then strTemp = "0" & strTemp
  strTimeStamp = strTimeStamp & strTemp
  'get the day
  strTemp = day(now())
  if len(strTemp) = 1 then strTemp = "0" & strTemp
  strTimeStamp = strTimeStamp & strTemp & "_"
  'get the hour
  strTemp = hour(now())
  if len(strTemp) = 1 then strTemp = "0" & strTemp
  strTimeStamp = strTimeStamp & strTemp
  'get the minute
  strTemp = minute(now())
  if len(strTemp) = 1 then strTemp = "0" & strTemp
  strTimeStamp = strTimeStamp & strTemp
  'get the seconds
  strTemp = second(now())
  if len(strTemp) = 1 then strTemp = "0" & strTemp
  strTimeStamp = strTimeStamp & strTemp
  'setup testname variable
  if strFITTestScriptName <> "" then
     strTestName = strFITTestScriptName
  end if
  'Now we can setup the expected results path
  strExpectedResultsPath = "C:\Results_" & strTimeStamp & ".html"
  'Now start setting up variables used to send the command
  if strFITTestScriptName <> "" then
      strTestTypeCommand = strFITTestScriptName
  end if
  'create a windows shell object
  Set WshShell = CreateObject("WScript.Shell")
  WshShell.CurrentDirectory = strResultsDirectory
   'construct the command we want to send to it
  'this is useful for debug purposes
  TDOutput.Print "Launching FIT with this command:"
  TDOutput.Print strCommand
 '  strCommand = "cmd /C java -jar fitnesse.jar -p 8080 -c FitNesse.SuiteAcceptanceTests.SuiteWidgetTests.SetUpLinkTest > C:\results.xml"
   strCommand = "cmd /C java -jar fitnesse.jar -p 8080 -c "&strFITTestScriptName&" > "&strExpectedResultsPath
  WshShell.run strCommand
 ' strOutput = objExecObject.StdOut.readall()
  if strOutput <> "" then
     TDOutput.Print strOutput
     'if this was a visual test, then this a playback error but we can still go on to retrieve the results
     if instr(strOutput, "Fail") <= 0 then
          If Not Debug Then
             TDOutput.Print "Test Failed to launch"
             CurrentRun.Status = "Failed"
             CurrentTSTest.Status = "Failed"
          end if
          exit sub
     end if
  end if
  'if we reach here then the test ran correctly, we can now go and retrieve the results using the excel
     if instr(strOutput, "Pass") <= 0 then
        TDOutput.Print "Test passed"
        CurrentRun.Status = "Passed"
        CurrentTSTest.Status = "Passed"
     else
        TDOutput.Print "Test Failed"
        CurrentRun.Status = "Failed"
        CurrentTSTest.Status = "Failed"
     end if
    Set objFSO = CreateObject("Scripting.FileSystemObject")
  'msgbox objFSO.FileExists(strExpectedResultsPath)
  rc = objFSO.FileExists(strExpectedResultsPath)
  msgbox rc
  If ucase(rc) <> "TRUE" then
     sleep (5)
  End If

   TDOutput.Print "Uploading results from: " & strExpectedResultsPath
  set attachF = CurrentRun.Attachments
  Set theAttachment = attachF.AddItem(null)
  theAttachment.FileName = strExpectedResultsPath
  theAttachment.Type = 1
  theAttachment.Post
    TDOutput.Print "Finished"
End Sub
Function sleep(seconds)
 Dim startTime, endTime
 startTime = Time()
 endTime = DateAdd("s",seconds,startTime)
 While endTime >= Time()
 Wend
End Function

Hope this helps everyone trying to integrate QC with other tools..
The script can be enhanced in many ways, this is just the raw version demonstarting that integration is possible.

Happy Testing!


Update:

Here is a updated code snippet for the same:

' Created by Quality Center
' 11/25/2011 5:12:37 AM
' ====================================================

' ----------------------------------------------------
' Main Test Function
' Debug - Boolean. Equals to false if running in [Test Mode] : reporting to Quality Center
' CurrentTestSet - [OTA COM Library].TestSet.
' CurrentTSTest - [OTA COM Library].TSTest.
' CurrentRun - [OTA COM Library].Run.
' ----------------------------------------------------
Sub Test_Main(Debug, CurrentTestSet, CurrentTSTest, CurrentRun)
  ' *** VBScript Limitation ! ***
  ' "On Error Resume Next" statement suppresses run-time script errors.
  ' To handle run-time error in a right way, you need to put "If Err.Number <> 0 Then"
  ' after each line of code that can cause such a run-time error.
  ' clear ouFITut window
  TDOutput.Clear
   '***************** VARIABLES TO BE MODIFIED **************************
  Dim strFITDatabase : strFITDatabase = "FIT"
  Dim strFITUsername : strFITUsername = "Aditya"
  Dim strFIFITassword : strFIFITassword = "pass"
  Dim strFIFITroject : strFIFITroject = "Common"
  Dim strFITTestScriptName : strFITTestScriptName = CurrentTSTest.TestName
  Dim strResultsDirectory :  strResultsDirectory = "C:\Program Files\Fitnesse"
  '***********************************************************************************************
  Dim WshShell, objExecObject, strOutput
  Dim strCommand, strTestTypeCommand, strRes
  Dim strTestName
  'Now setup some variables to handle to test results
  Dim strMacroName : strMacroName = "ExtractResultsFromFIT"
  Dim strExpectedResultsPath
  Dim strTimeStamp
  Dim strTemp
  Dim strPort : strPort = CurrentTestSet.TestSetFolder
  'setup the timestamp in YYYYMMDD_HHMM format
  'get the year
  strTimeStamp = year(now())
  'get the month
  strTemp = month(now())
  if len(strTemp) = 1 then strTemp = "0" & strTemp
  strTimeStamp = strTimeStamp & strTemp
  'get the day
  strTemp = day(now())
  if len(strTemp) = 1 then strTemp = "0" & strTemp
  strTimeStamp = strTimeStamp & strTemp
  'get the hour
  strTemp = hour(now())
  if len(strTemp) = 1 then strTemp = "0" & strTemp
  strTimeStamp = strTimeStamp & strTemp
  'get the minute
  strTemp = minute(now())
  if len(strTemp) = 1 then strTemp = "0" & strTemp
  strTimeStamp = strTimeStamp & strTemp
  'get the seconds
  strTemp = second(now())
  if len(strTemp) = 1 then strTemp = "0" & strTemp
  strTimeStamp = strTimeStamp & strTemp
  'setup testname variable
  if strFITTestScriptName <> "" then
     strTestName = strFITTestScriptName
  end if
    intLength=Mid(strTimeStamp,1,15)
   strExpectedResultsPath  = "C:\Results\" & strTimeStamp&".html"
  'Now start setting up variables used to send the command
  if strFITTestScriptName <> "" then
      strTestTypeCommand = strFITTestScriptName
  end if
  'create a windows shell object
  Set WshShell = CreateObject("WScript.Shell")
  WshShell.CurrentDirectory = strResultsDirectory
   'construct the command we want to send to it
  'this is useful for debug purposes
  TDOutput.Print "Launching FIT with this command:"
  ProcessExists ("java.exe")
if  ProcessExists ("java.exe") = True then
msgbox "FitNesse is currently running on the machine and Port is not available to run this test.",,"Warning"
TDOutput.Print "Test Failed to launch"
CurrentRun.Status = "Not Completed"
TDOutput.Print "Test Not Completed"
'CurrentTSTest.Status = "Not Completed"
exit sub
end if

  'Now run the command which will launch FIT - if nothing happens, put the command into a
  'command prompt window (start > run > "cmd") to see if there are any errors from it
  'strCommand = "cmd /C java -jar fitnesse.jar -p "&strPort&" -c "&strFITTestScriptName&"?test >" &strExpectedResultsPath
  strCommand = "cmd /C java -jar fitnesse.jar -p "&strPort&" -c "&strFITTestScriptName&"?test >" &strExpectedResultsPath
   TDOutput.Print strCommand
   WshShell.run strCommand
  Dim objFSO,objFolder,colFiles
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFSO.GetFolder("C:\Program Files\Fitnesse\FitNesseRoot\files\testResults\"&strFITTestScriptName&"\")
  Set objFiles=objFolder.Files
      'Delete if there are any files exist in the folder
      For Each item In objFiles
        On Error Resume Next
        objFSO.DeleteFile(item)
      Next
    ' Check if the latest results file appears in the directory
  Do until objFolder.Files.Count > 0
  Loop
  For each item in objFiles
      myFileName=item.Name
      myFileName="C:\Program Files\Fitnesse\FitNesseRoot\files\testResults\"&strFITTestScriptName&"\" & myFileName
      'msgbox myFileName
      strData= LoadSchemaToArray(myFileName)
      'msgbox strData
  Next

  'if we reach here then the test ran correctly, we can now go and retrieve the results using the excel
  if instr(1,strData, "0")= 0 OR instr(1,strData, "0")= 0 then
     'msgbox  instr(1,strData, "0",1),,"0"
     'msgbox  instr(1,strData, "0",1),,"0"
     'msgbox  instr(1,strData, "0",1),,"0"
     TDOutput.Print "Test Failed"
     CurrentRun.Status = "Failed"
     CurrentTSTest.Status = "Failed"
     else
     TDOutput.Print "Test Passed"
     CurrentRun.Status = "Passed"
     CurrentTSTest.Status = "Passed"
  end if
  TDOutput.Print "Uploading results from: " & strExpectedResultsPath
  Set attachF = CurrentRun.Attachments
  Set theAttachment = attachF.AddItem(null)
  'theAttachment.FileName = myFileName
  theAttachment.FileName = strExpectedResultsPath
  theAttachment.Type = 1
  theAttachment.Post
  TDOutput.Print "Finished"
End Sub
Function LoadSchemaToArray (filename)
    Dim objFSO, strTextFile, strData, arrTags
    dim  arrXMLSchema()
    const ForReading = 1
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Open the text file  - put the whole thing into an array
    Delay(10)
    strData = objFSO.OpenTextFile(filename,ForReading).Read(260)
    'Cleanup
    Set objFSO = Nothing
    LoadSchemaToArray=strData
End Function
Function ProcessExists (ByVal strProcessName)
        Dim strFuncName:strFuncName = "ProcessExists: "
        Dim strComputer, strProcess
        Dim objService
            If Trim (strProcessName) = "" Then
                ProcessExists = FALSE
                Exit Function
        End If
        ' This statement tells to use the current machine
        strComputer = "."
        ' "winmgmts:" is used to access the root of the CIM library
        Set objService = GetObject ("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        For Each strProcess in objService.InstancesOf ("Win32_process")
                If LCase (strProcess.Name) = LCase (strProcessName) Then
                        ProcessExists = TRUE
                        Exit Function
                End If
        Next
        ' Return
        ProcessExists = FALSE
End Function
Sub Debug2(myText)
  ' Uncomment the next line to turn off debugging
  ' Exit Sub
  If Not IsObject(objIEDebugWindow) Then
    Set objIEDebugWindow = CreateObject("InternetExplorer.Application")
    objIEDebugWindow.Navigate "about:blank"
    objIEDebugWindow.Visible = True
    objIEDebugWindow.Toolbar = False
    objIEDebugWindow.Width = 200
    objIEDebugWindow.Height = 300
    objIEDebugWindow.Left = 10
    objIEDebugWindow.Top = 10
    Do While objIEDebugWindow.Busy
      WScript.Sleep 100
    Loop
    objIEDebugWindow.Document.Title = "IE Debug Window"
    objIEDebugWindow.Document.Body.InnerHTML = _
                 "" & Now & "
"
  End If
  objIEDebugWindow.Document.Body.InnerHTML = _
                   objIEDebugWindow.Document.Body.InnerHTML _
                   & myText & "
" & vbCrLf
End Sub
Sub Delay( seconds )
    Dim wshShell
    Set wshShell = CreateObject( "WScript.Shell" )
    wshShell.Run "ping -n " & ( seconds + 1 ) & " 127.0.0.1", 0, True
    Set wshShell = Nothing
End Sub