Some Custom functions in QTP

I am placing few of the custom function which I have written, below. These can be reused in the same form without changes and will try to add more here.

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

Function current_date(date_format)

dim c_date

   Select Case date_format

  Case "dd.mm.yyyy"

c_date=Day(now())&"."&Month(Now())&"."&Year(Now())

Case "dd/mm/yyyy"

c_date=Day(now())&"/"&Month(Now())&"/"&Year(Now())

   End Select

   current_date=c_date

End Function

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

Sub sap_exit()

SAPGuiSession("type:=GuiSession","name:=ses.0.").Reset " "

SAPGuiSession("type:=GuiSession","name:=ses.0.").Reset "ex"

End Sub

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

'This function returns arrays of dates from_date to to_date

Function middle_dates(from_date, to_date)

f_date=getdate(from_date)

t_date=getdate(to_date)

'msgbox "start:"&f_date &"/n End:" & t_date

diff=datediff("d",f_date,t_date)

num_elements=CInt(diff)

dim arr_date()

ReDim arr_date(num_elements)

arr_date(0)=format_date(f_date,"dd.mm.yyyy")

For counter=1 to diff

d_var=dateadd("d", counter,f_date)

arr_date(counter)=format_date(d_var, "dd.mm.yyyy")

Next

middle_dates=arr_date

End Function

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

' This function takes date in dd.mm.yyyy format and convert it to the system date format to be processed

function getdate(d)

str=Split(d,".")

str_day=str(0)

str_month=str(1)

str_year=str(2)

d=dateserial(str_year,str_month,str_day)

'msgbox d

getdate=d

end function

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

'This cuntion converts date to the required format

Function format_date(dt, format)

return_date=""

  d=CInt(day(dt))

If d<10 Then

d="0"&cstr(d)

End If

m=cint(month(dt))

If m<10 Then

m="0" & cstr(m)

End If

y=year(dt)

Select Case (format)

Case "dd.mm.yyyy"

 return_date=d &"." & m & "." & y 

End Select

format_date=return_date

End Function

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

'get temp file path

Function getTempFilePath(fileName)

Set objShell = CreateObject("WScript.Shell")

Set colEnvironment = objShell.Environment("PROCESS")

objPath = colEnvironment("temp")

getTempFilePath=objPath&"\"&fileName

End Function

'***************************************************************************
'Generic function to capture screenshot

'Funciton to capture the screenshot

Function CaptureScreenshot(obj)

obj.capturebitmap gettempfilepath("screenshot.png"), true

    CaptureScreenshot=gettempfilepath("screenshot.png")

End Function

'***************************************************************************
'Function Name:current_time
'Function returns current time in HH:MM:SS format

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

Function current_time()
   current_time=hour(now())&":"&minute(now())&":"&second(now())
End Function

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

'This subroutine logs SAP status bar event

Sub ReportStatusBarEvent_Desc(obj,desc, screenshot)

   text=obj.getROProperty("text")

   msgtype=obj.getROProperty("messagetype")

If Strcomp(msgtype,"S",1)=0 Then

reporter.ReportEvent  micPass,desc, text, screenshot

else

reporter.ReportEvent  micFail,desc, text, screenshot

End If

End Sub

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

'Function Name:CustomWait
'Description:This function is written to have custom wait on object
'******************************************************************************************************************
Sub CustomWait(obj, MaxWaitTime)
flag=true
counter=0
While (flag AND counter<=MaxWaitTime)
If obj.exist Then
'If obj.getroproperty("enabled") Then
flag=false
wait 3
'End If
else
wait 3
counter=counter+3
End If
Wend
End Sub

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

'Function Name:CustomSendKeys

'Description:Function to use sendkeys operation

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

Sub CustomSendKeys(obj, desc)

    set wsh=createobject("WScript.Shell")

wsh.SendKeys desc

Set wsh=nothing

End Sub

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

'You can register these functions with multiple object using registeruserfunc .