³£ÓÃQTPº¯ÊýºÏ¼¯

³£ÓÃQTPº¯ÊýºÏ¼¯

'**************************************************************************
*****************************************************
'ÓÐÓõÄûÓõĶ¼¶ªµ½Ò»Æ𣬿ÉÄÜ»áÓÐÄãÏëÒªµÄ£¬Ô­±¾ÊÇ·ÖΪFileOper¡¢DataOper¡¢We
bOper£¨»ùÓÚSAFFRON£©¡¢Win32OperºÍErrorOperÎå¸öÎļþ
'ºóÃæÈý¸ö³¬¼¶†ªà³¬¼¶³¤µÄ·ÏÎï¿ÉÄܱðÈËÓò»µ½£¬²»¹ý¹¹Ôì˼·±È½ÏÇåÎú£¬´ó¼Ò¿ÉÒÔ
DIYһϣ¬»òÐíÄã»á¾õµÃºÜ·½±ã£¬ÖÁÉÙ¿ÉÒÔ²»ÓÃCheckPoint
'**************************************************************************
*****************************************************
classArray = Split("Browser,Page,Frame",",")
descArray = Split("micclass:=Browser,micclass:=Page,micclass:=Frame,",",")
objectArray = Split("Link,WebButton,WebList,WebEdit,Image", ",")
objectDescArray =
Split("micclass:=Link,micclass:=WebButton,micclass:=WebList,micclass:=WebEd
it,micclass:=Image", ",")
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º¹Ø±ÕËùÓдò¿ªµÄIE
'³ÌÐòÊäÈ룺
'³ÌÐòÊä³ö£º
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-08
'µ÷ÓþÙÀý£ºCloseBrowsers
'**************************************************************************
*****************************************************
Public Sub CloseAllBrowser
Set Wshshell = CreateObject("Wscript.Shell")
Set DialogObject = Description.Create()
DialogObject("micclass").Value = "Dialog"
Set Windows32Dialog = Desktop.ChildObjects(DialogObject)
dlNum = Windows32Dialog.Count - 1
For v = 0 to dlNum
Windows32Dialog(v).Close
Next
Set Windows32Dialog = Nothing
Set theBrowser = Browser("micclass:=Browser", "index:=0")
While theBrowser.Exist(0)
theBrowser.Close
'ÓÐЩϵͳҳÃæ¿ÉÄÜÔڹرյÄʱºò»áÓÐÌáʾ¶Ô»°¿ò³öÏÖ
waitNx = 1
Do While waitNx < 5
Set Windows32Dialog = Desktop.ChildObjects(DialogObject)
dlNum = Windows32Dialog.Count - 1
For v = 0 to dlNum
dlText = Windows32Dialog(v).GetROProperty("regexpwndtitle")
Wshshell.AppActivate(dlText)
Wait(1)
Wshshell.SendKeys "{ENTER}"
Next
Set Windows32Dialog = Nothing
waitNx = waitNx + 1
Loop
Report
Pass,"ʹÓÃCloseAllOpenedBrowsersº¯ÊýÒ³Ãæ¹Ø±Õ³É¹¦","µ±Ç°Ò³Ãæ¹Ø±Õ³É¹¦£¡"
Wend
Set theBrowser = Nothing
Set DialogObject = Nothing
Set Wshshell = Nothing

End Sub
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º×î´ó»¯IEä¯ÀÀÆ÷
'³ÌÐòÊäÈ룺ÎÞ
'³ÌÐòÊä³ö£ºÎÞ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-08
'µ÷ÓþÙÀý£ºMaximizeBrowser
'**************************************************************************
*****************************************************
Sub MaximizeBrowser
Set BrowserObject = Description.Create()
BrowserObject("NativeClass").Value = "IEFrame"
Set WindowsBrowser = Desktop.ChildObjects(BrowserObject)
brNum = WindowsBrowser.Count - 1
For i = 0 To brNum
ieVersion = WindowsBrowser(i).GetROProperty("version")
wndTitle = WindowsBrowser(i).GetROProperty("title")
Set bjectBrowser = Browser("micclass:=Browser", "index:="&i)
If Instr(ieVersion,6) > 0 Then
Window("regexpwndclass:=IEFrame","index:=0","text:="&wndTitle&".*").M
aximize
Else
WindowsBrowser(i).Maximize
End If
Set bjectBrowser = Nothing
Next
Set WindowsBrowser = Nothing
Set BrowserObject = Nothing
End Sub
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º¸ù¾Ý¶ÔÏóÊôÐÔÁбíºÍÊôÐÔÖµÁбíÆ¥ÅäBrowser¶ÔÏ󣬸ú¯Êý»ù±¾ÎÞÓá­ ¡­
'³ÌÐòÊäÈ룺¶ÔÏóÊôÐÔÁбíºÍÊôÐÔÖµÁÐ±í£¬ÁбíʹÓÃÓ¢ÎÄ°ë½ÇµÄ¶ººÅ·Ö¸ô
'³ÌÐòÊä³ö£º´´½¨¶ÔÏó
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-08
'µ÷ÓþÙÀý£ºGenerateBrowserObject("name,title","±£ÏÕÒµÎñ¹ÜÀíϵͳ,±£ÏÕÒµÎñ¹Ü
Àíϵͳ")
'**************************************************************************
*****************************************************
Public Function GenerateBrowser(p_Attlist,p_Keylist)
AttArray = Split(p_Attlist,",")
KeyArray = Split(p_Keylist,",")
exeStr = "Browser("
If UBound(AttArray) <> UBound(KeyArray) Then
Report
Fail,"ʹÓÃGenerateBrowserObjectº¯Êý²ÎÊýÊäÈë´íÎó","¶ÔÏóÊôÐԵĸöÊýÓ¦¸ÃÓë
Æä¶ÔÓ¦µÄÊôÐÔÖµ¸öÊýÏàµÈ£¡"
Exit Function
End If
For inx = 0 to UBound(AttArray)
exeStr =
exeStr&Chr(34)&AttArray(inx)&":=.*"&KeyArray(inx)&".*"&Chr(34)&","

Next
Execute "Set MyObject = "&exeStr&Quote("index:=0")&")"
If MyObject.Exist(0) Then
Report
Pass,"ʹÓÃGenerateBrowserObjectº¯Êý¹¹Ôì¶ÔÏó³É¹¦","°´ÕÕBrowser¶ÔÏóÊôÐÔÁÐ
±í¡¾"&p_Attlist&"¡¿£¬ÊôÐÔÖµÁÐ±í¡¾"&p_Keylist&"¡¿£¬Éú³ÉBrowser¶ÔÏó³É¹¦£¡
"
Else
Report
Fail,"ʹÓÃGenerateBrowserObjectº¯Êý¹¹Ôì¶ÔÏóʧ°Ü","°´ÕÕBrowser¶ÔÏó°´ÕÕÊô
ÐÔÁÐ±í¡¾"&p_Attlist&"¡¿£¬ÊôÐÔÖµÁÐ±í¡¾"&p_Keylist&"¡¿£¬Æ¥ÅäBrowser¶ÔÏóʧ
°Ü£¡"
ExitRun
End If
Set GenerateBrowser = MyObject
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º³õʼ»¯ËùÓдò¿ªµÄBrowserÒ³Ã棬²»ÑáÉè¼Æ¸´ÔÓֻΪÎȶ¨¸ßЧ
'³ÌÐòÊäÈ룺ÎÞ
'³ÌÐòÊä³ö£º³õʼ»¯³É¹¦»òÕßʧ°Ü
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-08
'µ÷ÓþÙÀý£ºBrowserSync
'**************************************************************************
*****************************************************
Public Function SyncronizeBrowser()
Set MyBrowser = Browser("micclass:=Browser", "index:=0")
If MyBrowser.Exist(0) Then
MyBrowser.Sync
Do Until MyBrowser.GetROProperty("url") <> "" And
MyBrowser.GetROProperty("name") <> ""
Delay 50
Loop
Else
Set MyBrowser = Nothing
SyncronizeBrowser = False
Report Warning ,"³õʼ»¯Ò³Ãæʧ°Ü","Ò³Ãæ³õʼ»¯Ê§°Ü£¬ÐèÒªÖØвÙ×÷£¡"
Exit Function
End If
Set MyBrowser = Nothing
SyncronizeBrowser = True
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º´ò¿ªÖ¸¶¨µÄµØÖ·£¬²¢ÇÒ³õʼ»¯Ò³Ã棬Ìرð˵Ã÷£º¶ÔÓÚµØÖ·À¸³öÏÖÒ»´ÎÐÔse
ssionidµÄÍøÒ³²»¿ÉÓøú¯Êý
'³ÌÐòÊäÈ룺urlµØÖ·
'³ÌÐòÊä³ö£º³õʼ»¯³É¹¦»òÕßʧ°Ü
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-08
'µ÷ÓþÙÀý£ºprint SyncronizeSepecifiedURL("www.baidu.com")
'**************************************************************************
*****************************************************
Public Function NavigateBrowser(para_myuri)

CloseAllBrowser
Set IEBrowser = CreateObject("InternetExplorer.Application")
IEBrowser.Visible = True
IEBrowser.Navigate para_myuri
Set bjectBrowser = Browser("micclass:=Browser", "index:=0")
Do Until SyncronizeBrowser() = True
Wait(1)
Loop
actualurl = ObjectBrowser.GetROProperty("url")
'ÏÂÃæÕâ¸öÅжÏÖ÷ÒªÊÇΪÁ˽â¾ö³õʼ»¯µØÖ·ÌøתÎÊÌ⣬Èç¹ûURL·¢Éú±ä»¯»áµ¼Ö¶ÔÏó
ÊôÐÔ·¢Éú±ä»¯´Ó¶øµ¼ÖÂÔËÐдíÎó¡£
If actualurl <> para_myuri Then
ObjectBrowser.Close
Set IEBrowser = Nothing
Set IEBrowser = CreateObject("InternetExplorer.Application")
IEBrowser.Visible = True
IEBrowser.Navigate actualurl
If Not SyncronizeBrowser() Then
Report
Warning,"ʹÓÃNavigateBrowserº¯ÊýIE³õʼ»¯Ê§°Ü","´ò¿ªÖ¸¶¨Ò³Ã桾"&myuri&
"¡¿ÔÚ³õʼ»¯µÄʱºòʧ°Ü£¡"
Set MyBrowser = Nothing
Set IEBrowser = Nothing
Exit Function
End If
End If
Set bjectBrowser = Nothing
Set IEBrowser = Nothing
Report
Pass,"ʹÓÃNavigateBrowserº¯ÊýIE³õʼ»¯³É¹¦","´ò¿ªÖ¸¶¨Ò³Ã桾"&para_myuri&"
¡¿²¢ÇÒ³õʼ»¯³É¹¦£¡"
NavigateBrowser = True
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º´¦Àíµ¯³ö¶Ô»°¿ò£¬Ö÷ÒªÓÃÓÚµ¯³öµÄ¿ÉÔ¤ÖªÐÔÄܹ»µÃµ½¿ØÖƵĵط½£¬Î´Öªµ¯
³öÐèÒýÓÃÆäËûº¯Êý´¦Àí
'³ÌÐòÊäÈ룺ѡÔñ¶Ô»°¿ò²Ù×÷£ºÊÇ/·ñ/È·ÈÏ/È¡Ïû/È·¶¨µÈµÈ£¬ÊÇ·ñÐèÒªÏò½á¹ûÖÐÌí¼ÓÌá
ʾÐÅÏ¢µÄ±¨¸æ
'³ÌÐòÊä³ö£º½á¹û±¨¸æ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-08
'µ÷ÓþÙÀý£ºHandleDialog "È·ÈÏ","Y"
'**************************************************************************
*****************************************************
Public Function HandleDialog(regexpName,needAlertInfo)
If Trim(regexpName) = "" Then
regexpName = "ÎÞÐèÆ¥ÅäµÄ°´Å¥£¡"
End If
Set Wshshell = CreateObject("Wscript.Shell")
Set DialogObject = Description.Create()
DialogObject("micclass").Value = "Dialog"
Set WindowsDialog = Desktop.ChildObjects(DialogObject)
dlNum = WindowsDialog.Count - 1
If dlNum < 0 Then
Set WindowsDialog = Nothing

Set DialogObject = Nothing
Report micDone,"ûÓÐÈκε¯³ö¿ò","²»ÐèÒª½øÐжԻ°¿òµÄ´¦Àí£¡"
Exit Function
End If
For inx = 0 to dlNum
If needAlertInfo = "Y" Or needAlertInfo = True Then
Set StaticObject = Description.Create()
StaticObject("micclass").Value = "Static"
Set WindowsStatic = WindowsDialog(inx).ChildObjects(StaticObject)
stNum = WindowsStatic.Count
disMessage = WindowsStatic(stNum - 1).GetROProperty("text")
Report micDone,"»ñÈ¡ÍøÒ³¶Ô»°¿òÐÅÏ¢³É¹¦£º",disMessage
Set WindowsStatic = Nothing
Set StaticObject = Nothing
End If
dialogTitle = WindowsDialog(inx).GetROProperty("text")
Set WinButtonObject = Description.Create()
WinButtonObject("micclass").Value = "WinButton"
Set WindowsButton = WindowsDialog(inx).ChildObjects(WinButtonObject)
wbNum = WindowsButton.Count - 1
For binx = 0 to wbNum
btName = WindowsButton(binx).GetROProperty("text")
If Instr(btName,regexpName) > 0 Then
WindowsButton(binx).Click
Report
Pass,"º¯ÊýHandleDialogµã»÷Ö¸¶¨°´Å¥³É¹¦","°´ÕÕÖ¸¶¨µÄ°´Å¥Ãû³Æ¡¾"&rege
xpName&"¡¿²éÕÒ²¢µã»÷°´Å¥³É¹¦£¡"
Exit For
End If
If binx = wbNum And Instr(btName,regexpName) = 0 Then
Wshshell.AppActivate(dialogTitle)
Wait(0)
Wshshell.SendKeys "{ENTER}"
Report
micWarning,"º¯ÊýHandleDialogµã»÷°´Å¥","ûÓÐÆ¥Åäµ½Ö¸¶¨°´Å¥£¬¶ÔÒѾ­µ¯
³öµÄ¶Ô»°¿òÖ±½ÓʹÓÃĬÈϲÙ×÷£¡"
End If
Next
Set WindowsButton = Nothing
Set WinButtonObject = Nothing
Next
Set WindowsDialog = Nothing
Set DialogObject = Nothing
Set Wshshell = Nothing
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£ºSAFFRON¿ò¼ÜÒýÓÃÒÔ¼°²¿·Ö¸ÄÔ죬º¯Êý·ÖÁ÷Ö®ºóµÄ²¿·Ö
'³ÌÐòÊäÈ룺²Î¼û¸÷¸öº¯Êý
'³ÌÐòÊä³ö£º
'Éè¼ÆÈËÔ±£º
'Éè¼Æʱ¼ä£º2011-01-08
'µ÷ÓþÙÀý£º
'**************************************************************************
*****************************************************

Public Function GenerateDescription (classString,isModleWindow)
classNx = IndexOf(classArray, classString)
If classNx >= 0 Then
'Ôö¼Ó¶Ôģ̬´°¿ÚµÄÖ§³Ö
If isModleWindow = "Y" Or isModleWindow = True Then
descString = "Window("&Quote("nativeclass:=Internet
Explorer_TridentDlgFrame")&")."
Else
descString = classArray(0)&"("&Quote(descArray(0))&")."
End If
If classNx >= 1 Then
descString = descString + classArray(1)&"("&Quote(descArray(1))&")."
If 2 >= classNx Then
If hasFrameValue <> "" Then
descString = descString +
classArray(2)&"("&Quote(descArray(2))&","&Quote("name:="&hasFrame
Value)&")."
End If
End If
End If
End If
GenerateDescription = descString
End Function
'**************************************************************************
**********************************************
Public Function GenerateObjectDescription (objClassName, otherAtt)
objNx = IndexOf(objectArray, objClassName)
objNameString = ""
If objNx <> -1 Then
objNameString =
objClassName&"("&Quote(objectDescArray(objNx))&","&Quote(otherAtt)&","&
Quote("index:=0")&")."
End If
GenerateobjectDescription = objNameString
End Function
'**************************************************************************
**********************************************
Public Function ObjectWorkUnderFrame(frameName)
hasFrameValue = frameName
End Function
'**************************************************************************
**********************************************
Public Function ObjectNotWorkUnderFrame()
hasFrameValue = ""
End Function
'**************************************************************************
**********************************************
Public Function VerifyObject (objectClassName, text,isModleWindow)
rval = false
localDesc = ""
estr = ""
If hasFrameValue <> "" Then

localDesc = GenerateDescription(classArray(2),isModleWindow)
Else
localDesc = GenerateDescription(classArray(1),isModleWindow)
End If
Select Case objectClassName
Case "Page"
Execute "rval =
"&GenerateDescription(classArray(1),isModleWindow)&"Exist (0)"
If rval Then
Execute "title =
"&GenerateDescription(classArray(1),isModleWindow)&"GetROProperty("
&Quote("title")&")"
If title = text Then
rval = true
Else
rval = false
End If
End If
Case "CurrentFrame"
If hasFrameValue <> "" Then
estr = "rval = "&localDesc
End If
Case "Link"
estr = "rval = "&localDesc&GenerateObjectDescription("Link",
"innertext:=.*"&text&".*")
Case "WebButton"
estr = "rval = "&localDesc&GenerateObjectDescription("WebButton",
"value:=.*"&text&".*")
Case "WebList"
estr = "rval = "&localDesc&GenerateObjectDescription("WebList",
"name:=.*"&text&".*")
Case "WebEdit"
estr = "rval = "&localDesc&GenerateObjectDescription("WebEdit",
"name:=.*"&text&".*")
End Select
If estr <> "" Then
Execute estr + "Exist (0)"
End If
If rval Then
Report micDone, objectClassName&"Æ¥Åä¶ÔÏó³É¹¦",
"¶ÔÏó¡¾"&objectClassName&"¡¿¡¾ "&Quote(text)&" ¡¿²éѯ³É¹¦£¡"
VerifyObject = True
Else
Report Warning, objectClassName&"Æ¥Åä¶ÔÏóʧ°Ü",
"¶ÔÏó¡¾"&objectClassName&"¡¿¡¾ "&Quote(text)&" ¡¿²éѯÎÞ¹û£¡"
VerifyObject = False
End If
End Function
'**************************************************************************
**********************************************
Public Function ClickSpecifiedObject (objectClassName, text, isModleWindow)
localDesc = ""
If hasFrameValue <> "" Then
localDesc = GenerateDescription(classArray(2),isModleWindow)
Else
localDesc = GenerateDescription(classArray(1),isModleWindow)
End If
Select Case objectClassName

Case "Link"
Execute
localDesc&GenerateObjectDescription("Link","innertext:=.*"&text&".*")
&"Click"
SyncronizeBrowser
Report micDone,
"Á´½Óµã»÷Íê³É£º","Á´½Ó¡¾"&text&"¡¿µã»÷Íê±Ï£¬²¢ÇÒÒѾ­Ö´ÐÐÍøÒ³³õʼ»¯£¡"
Case "WebButton"
Execute localDesc&GenerateObjectDescription("WebButton",
"value:=.*"&text&".*")&"Click"
SyncronizeBrowser
Report micDone, "°´Å¥µã»÷Íê³É£º",
"°´Å¥¡¾"&text&"¡¿µã»÷Íê±Ï£¬²¢ÇÒÒѾ­Ö´ÐÐÍøÒ³³õʼ»¯£¡"
Case "Image"
Execute localDesc&GenerateObjectDescription("Image",
"alt:=.*"&text&".*")&"Click"
SyncronizeBrowser
Report micDone, "ͼ±êµã»÷Íê³É£º",
"ͼ±ê¡¾"&text&"¡¿µã»÷Íê±Ï£¬²¢ÇÒÒѾ­Ö´ÐÐÍøÒ³³õʼ»¯£¡"
End Select
End Function
'**************************************************************************
**********************************************
Public Function SelectFromList (objectName, text, isModleWindow)
localDesc = ""
rv = ""
rval = false
If hasFrameValue <> "" Then
localDesc = GenerateDescription(classArray(2),isModleWindow)
Else
localDesc = GenerateDescription(classArray(1),isModleWindow)
End If
localDesc = localdesc&GenerateObjectDescription("WebList",
"name:=.*"&objectName&".*")
Execute "cnt = "&localDesc&"GetROProperty("&Quote("items count")&")"
For i = 1 to cnt
Execute "rv = "&localDesc&"GetItem ("&i&")"
If rv = text Then
rval = true
End If
Next
If rval Then
Execute localDesc&"Select "&Quote(text)
SyncronizeBrowser
Report micDone, "ÏÂÀ­ÁбíÑ¡Ôñ³É¹¦",
"Ñ¡ÔñÏ"&text&"¡¿ÒѾ­±»²éѯµ½¡¢Ñ¡Ôñ£¬²¢ÇÒÖ´Ðгõʼ»¯£¡"
Else
Report micFail, "ÏÂÀ­ÁбíÑ¡Ôñʧ°Ü",
"Ñ¡ÔñÏ"&text&"¡¿Ã»ÓÐÔÚÏÂÀ­ÁÐ±í¡¾"&objectName&"¡¿Öвéѯµ½²éѯµ½£¡"
Exit Function
End If
SelectFromList = True
End Function
'**************************************************************************
**********************************************
Public Function EnterValueForEdit (objectName, text,isModleWindow)

localDesc = ""
rval = true
If hasFrameValue <> "" Then
localDesc = GenerateDescription(classArray(2),isModleWindow)
Else
localDesc = GenerateDescription(classArray(1),isModleWindow)
End If
localDesc = localdesc&GenerateObjectDescription("WebEdit",
"name:=.*"&objectName&".*")
Execute localDesc&"Set ("&Quote(text)&")"
Report micDone, "Îı¾¿òÊäÈë²Ù×÷£º",
"Îı¾¡¾"&text&"¡¿³É¹¦ÊäÈëµ½ÊäÈë¿ò¡¾"&objectName&"¡¿!"
EnterValueForEdit = rval
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º´ÓÊý¾Ý¿âÖÐץȡָ¶¨±íºÍÁеÄÊý¾Ý£¬ÒÀÀµORAOLEDB×é¼þµÄÕý³£Ê¹Ó㬲»ÓÃ
´´½¨Êý¾ÝÔ´£¬²»ÓÃÅäÖÃÁ¬½Ó´®
'³ÌÐòÊäÈ룺
' ÒªÖ´ÐеÄsqlÓï¾ä
' ҪץȡµÄ×Ö¶Î
' Êý¾Ý¿âÓû§Ãû
' Êý¾Ý¿âÖ÷»úµÄÓòÃû»òIP
' Êý¾Ý¿âÖ÷»úµÄ¶Ë¿Ú
' Êý¾Ý¿âʵÀýSID
' Êý¾Ý¿âÓû§µÄÃÜÂë
'³ÌÐòÊä³ö£ºÒª×¥È¡µÄ×Ö¶Î
'Éè¼ÆÈËÔ±: LIUYI027
'Éè¼Æʱ¼ä£º2009-09-26
'µ÷ÓþÙÀý£ºMsgBox FetchDBDataOle("select * from
plan","plan_code","A","10.31.10.105","1555","B","C")
'**************************************************************************
*****************************************************
Public Function
FetchDBData(DBUserName,DBHostAddress,DBServerPort,DBSid,DBPassWord,sqlText,
tableColumn)
Set DBRec=createobject("adodb.recordset")
Set DBCon=createobject("adodb.Connection")
DBCon.ConnectionString="Provider=""OraOLEDB.Oracle"";User ID="&_
DBUserName &";Data Source=""(description =(address = (protocol =
tcp)(host = "&_
DBHostAddress &")(port = "&_
DBServerPort&"))(connect_data =(sid = "&_
DBSid&")))"";Password="&_
DBPassWord&""
DBCon.Open
DBRec.Open sqlText,DBCon
FetchDBData = DBRec.Fields(tableColumn)
DBCon.Close
Set DBRec = Nothing
Set DBCon = Nothing
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º´ÓÊý¾Ý¿âÖÐץȡָ¶¨±íºÍÁеÄÊý¾Ý£¬»ùÓÚMSDAORA¶ÔÏóµÄʹÓ㬲»ÒÀÀµORA

OLEDB£¬²»Óô´½¨Êý¾ÝÔ´£¬²»ÓÃÅäÖÃÁ¬½Ó´®
'³ÌÐòÊäÈ룺
' ÒªÖ´ÐеÄsqlÓï¾ä
' ҪץȡµÄ×Ö¶Î
' Êý¾Ý¿âÓû§Ãû
' Êý¾Ý¿âÖ÷»úµÄÓòÃû»òIP
' Êý¾Ý¿âÖ÷»úµÄ¶Ë¿Ú
' Êý¾Ý¿âʵÀýSID
' Êý¾Ý¿âÓû§µÄÃÜÂë
'³ÌÐòÊä³ö£ºÒª×¥È¡µÄ×Ö¶Î
'Éè¼ÆÈËÔ±: LIUYI027
'Éè¼Æʱ¼ä£º2009-09-26
'µ÷ÓþÙÀý£ºMsgBox FetchDBData("select * from
plan","plan_code","A","10.31.10.105","1555","B","C")
'**************************************************************************
*****************************************************
Public Function
FetchDBDataMSDAORA(DBUserName,DBHostAddress,DBServerPort,DBSid,DBPassWord,s
qlText,tableColumn)
Set DBCon = CreateObject("ADODB.Connection")
Set DBRec = CreateObject("ADODB.RecordSet")
DBCon.Open = "Provider=""MSDAORA.Oracle"";User ID="&_
DBUserName&";Data Source=""(description =(address = (protocol = tcp)(host
= "&_
DBHostAddress &")(port = "&_
DBServerPort&"))(connect_data =(sid = "&_
DBSid&")))"";Password="&_
DBPassWord&""
DBRec.OPEN sqlText,DBCon
FetchDBDataMSDAORA = DBRec.fields(tableColumn)
DBCon.close
Set DBCon =Nothing
Set DBRec = Nothing
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º°´ÕÕ´«ÈëSQLÐÞ¸ÄÊý¾Ý¿âµÄÖµ£¬ÒÀÀµORAOLEDB×é¼þµÄÕý³£Ê¹Ó㬲»Óô´½¨
Êý¾ÝÔ´£¬²»ÓÃÅäÖÃÁ¬½Ó´®
'³ÌÐòÊäÈ룺
' ÒªÖ´ÐеÄsqlÓï¾ä
' Êý¾Ý¿âÓû§Ãû
' Êý¾Ý¿âÖ÷»úµÄÓòÃû»òIP
' Êý¾Ý¿âÖ÷»úµÄ¶Ë¿Ú
' Êý¾Ý¿âʵÀýSID
' Êý¾Ý¿âÓû§µÄÃÜÂë
'³ÌÐòÊä³ö£ºÎÞ
'Éè¼ÆÈËÔ±: LIUYI027
'Éè¼Æʱ¼ä£º2009-09-26
'µ÷ÓþÙÀý£ºCall ModifyDBDataOle("A","10.31.10.105","1555","B","C"£¬"update
Test set Col = 'A' where Col = 'B'")
'**************************************************************************
*****************************************************
Public Sub
ModifyDBData(DBUserName,DBHostAddress,DBServerPort,DBSid,DBPassWord,sqlText
)
Set DBRec=createobject("adodb.recordset")

Set DBCom=createobject("adodb.command")
DBCom.activeconnection="Provider=""OraOLEDB.Oracle"";User ID="&_
DBUserName&";Data Source=""(description =(address = (protocol = tcp)(host
= "&_
DBHostAddress&")(port = "&_
DBServerPort&"))(connect_data =(sid = "&_
DBSid&")))"";Password="&_
DBPassWord&""
DBCom.CommandType = 1
DBCom.CommandText = sqlText
Set DBRec = DBCom.Execute()
DBCom.CommandText = "commit"
Set DBRec = DBCom.Execute()
Set DBRec = Nothing
Set DBCom = Nothing
End Sub
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º°´ÕÕ´«ÈëSQLÐÞ¸ÄÊý¾Ý¿âµÄÖµ£¬²»ÒÀÀµORAOLEDB×é¼þµÄʹÓ㬲»Óô´½¨Êý
¾ÝÔ´£¬²»ÓÃÅäÖÃÁ¬½Ó´®
'³ÌÐòÊäÈ룺
' ÒªÖ´ÐеÄsqlÓï¾ä
' Êý¾Ý¿âÓû§Ãû
' Êý¾Ý¿âÖ÷»úµÄÓòÃû»òIP
' Êý¾Ý¿âÖ÷»úµÄ¶Ë¿Ú
' Êý¾Ý¿âʵÀýSID
' Êý¾Ý¿âÓû§µÄÃÜÂë
'³ÌÐòÊä³ö£ºÎÞ
'Éè¼ÆÈËÔ±: LIUYI027
'Éè¼Æʱ¼ä£º2009-09-26
'µ÷ÓþÙÀý£ºCall ModifyDBData("A","10.31.10.105","1555","B","C"£¬"update
Test set Col = 'A' where Col = 'B'")
'**************************************************************************
*****************************************************
Public Sub
ModifyDBDataMSDAORA(DBUserName,DBHostAddress,DBServerPort,DBSid,DBPassWord,
sqlText)
Set DBCon = CreateObject("ADODB.Connection")
Set DBRec = CreateObject("ADODB.RecordSet")
DBCon.Open = "Provider=""MSDAORA.Oracle"";User ID="&_
DBUserName&";Data Source=""(description =(address = (protocol = tcp)(host
= "&_
DBHostAddress &")(port = "&_
DBServerPort&"))(connect_data =(sid = "&_
DBSid&")))"";Password="&_
DBPassWord&""
DBRec.OPEN sqlText,DBCon
DBRec.OPEN "commit",DBCon
DBCon.Close
Set DBCon =Nothing
Set DBRec = Nothing
End Sub
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£ºµ÷Óô洢¹ý³Ì£¬²»ÒÀÀµORAOLEDB×é¼þµÄʹÓ㬲»Óô´½¨Êý¾ÝÔ´£¬²»ÓÃÅäÖÃ

Á¬½Ó´®
'³ÌÐòÊäÈ룺
' ÒªÖ´ÐеĴ洢¹ý³ÌÃû
' Êý¾Ý¿âÓû§Ãû
' Êý¾Ý¿âÖ÷»úµÄÓòÃû»òIP
' Êý¾Ý¿âÖ÷»úµÄ¶Ë¿Ú
' Êý¾Ý¿âʵÀýSID
' Êý¾Ý¿âÓû§µÄÃÜÂë
'³ÌÐòÊä³ö£ºÎÞ
'Éè¼ÆÈËÔ±: LIUYI027
'Éè¼Æʱ¼ä£º2009-09-26
'µ÷ÓþÙÀý£ºCall
RunProcedure("gbsjob.job_package.gbs_job4","pub_test","10.31.9.62","1562","
gs30gbs","test2012")
'**************************************************************************
*****************************************************
Sub
RunProcedure(procName,DBUserName,DBHostAddress,DBServerPort,DBSid,DBPassWor
d)
Set DBCon = CreateObject("ADODB.Connection")
Set DBRec = CreateObject("ADODB.RecordSet")
Set DBcom = CreateObject("ADODB.Command")
DBCon.Open = "Provider=""MSDAORA.Oracle"";User ID="&_
DBUserName&";Data Source=""(description =(address = (protocol = tcp)(host
= "&_
DBHostAddress&")(port = "&_
DBServerPort&"))(connect_data =(sid = "&_
DBSid&")))"";Password="&_
DBPassWord&""
DBcom.ActiveConnection = DBCon
DBcom.CommandType = 4
DBcom.CommandText = procName
DBcom.Execute
DBcom.CommandText = "commit"
DBcom.Execute
DBCon.close
Set DBcom = Nothing
Set DBCon =Nothing
Set DBRec = Nothing
End Sub
'**************************************************************************
********************************************************************
'Éè¼Æ˵Ã÷£ºÓÃÓÚ½«EXCELÖÐij¸öSHEETµ¥¶ÀCOPY³öÀ´µ½Ò»¸öÁÙʱµÄÎļþÖУ¬´ÓÁÙʱÎļþ
µ¼ÈëDATATABLE£¬±ÜÃâSHEET¹ý¶àµ¼ÖµÄEXCEL³ö´í
'³ÌÐòÊäÈ룺
' originalDataFile£º Ô­EXCEL
' tempFileForImpt£º еÄÁÙʱÎļþ
' oldSheet£º Ô­EXCELµÄSHEET
' newSheet£º еÄEXCELÁÙʱSHEET
'³ÌÐòÊä³ö£º½«Ö¸¶¨Â·¾¶ÏµÄÖ¸¶¨EXCELµÄÖ¸¶¨SHEETµ¼ÈëDataTable
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2008-11-05
'µ÷ÓþÙÀý£ºCall impXls("D:\test.xls","D:\temp.xls","ԭʼSHEET","еÄSHEET")
'**************************************************************************
********************************************************************
Public Sub impXls(originalDataFile,tempFileForImpt,oldSheet,newSheet)

Set Fso = CreateObject("Scripting.FileSystemObject")
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Application.Visible = False
If (Fso.FileExists(originalDataFile) = False) Then
Reporter.ReportEvent micFail,"²ÎÊýÎļþ²»´æÔÚ£º",originalDataFile
Print "²ÎÊýÎļþ²»´æÔÚ£º"&originalDataFile
Set newBook = Nothing
ExcelApp.Quit
Set ExcelApp = Nothing
Set Fso = Nothing
Exit Sub
End If
Set newBook = ExcelApp.Workbooks.Open (originalDataFile,False,True)
newBook.Worksheets(oldSheet).copy
Set tempBook=ExcelApp.ActiveWorkbook
If (Fso.FileExists(tempFileForImpt) = True) Then
Set tempxls = Fso.GetFile(tempFileForImpt)
tempxls.Delete
tempBook.SaveAs tempFileForImpt
Set tempxls = Nothing
Else
tempBook.SaveAs tempFileForImpt
End If
Set tempBook = Nothing
ExcelApp.Quit
Set ExcelApp = Nothing
DataTable.AddSheet newSheet
DataTable.ImportSheet tempFileForImpt,oldSheet,newSheet
If (Fso.FileExists(tempFileForImpt) = True) Then
Set tempFile = fso.GetFile(tempFileForImpt)
tempFile.Delete
Set tempFile = Nothing
End If
Set Fso = Nothing
Reporter.ReportEvent
micPass,"µ¼Èë²ÎÊýÎļþ³É¹¦£º","Îļþ£º¡¾"&originalDataFile&"¡¿£¬SHEETÒ³£º¡¾
"&newSheet&"¡¿"
End Sub
'**************************************************************************
********************************************************************
'Éè¼Æ˵Ã÷£ºÐ´Ö¸¶¨ÐкÍÁеÄEXCELµÄÖµ
'³ÌÐòÊäÈ룺
' sheet£º дÈëµÄSHEET£»
' row£º Ö¸¶¨ÐУ»
' col£º Ö¸¶¨µÄÐУ»
' value£º дÈëÖµ£»
' pathAndFile£º Îļþ·¾¶
'³ÌÐòÊä³ö£ºÐ´ÈëÖ¸¶¨µ¥Ôª¸ñ£¬ÎÞÐè·µ»Ø
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2008-11-05
'µ÷ÓþÙÀý£º Call WExcel("Ö¸¶¨Ò³",3,4,date,"D:\test.xls")
'**************************************************************************
********************************************************************
Public Sub WExcel(sheet,row,col,value,pathAndFile)
Set Fso = CreateObject("Scripting.FileSystemObject")
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = False
If Fso.FileExists(pathAndFile) = True Then

Set newBook = ExcelApp.Workbooks.Open(pathAndFile)
newBook.Worksheets(sheet).Activate
newBook.Worksheets(sheet).Cells(row,col).value=value
newBook.Save
ExcelApp.Application.Quit
Else
Set newBook = ExcelApp.Workbooks.Add
newBook.Worksheets(sheet).Activate
newBook.Worksheets(sheet).Cells(row,col).value=value
newBook.SaveAs pathAndFile
ExcelApp.Application.Quit
End If
Set newBook = Nothing
Set ExcelApp = Nothing
Set Fso = Nothing
Set Wshshell = Nothing
End Sub
'**************************************************************************
********************************************************************
'Éè¼Æ˵Ã÷£º¶ÁÖ¸¶¨ÐкÍÁеÄEXCELµÄÖµ
'³ÌÐòÊäÈ룺
' sheet£º ¶ÁÈ¡µÄSHEET£»
' row£º Ö¸¶¨ÐУ»
' col£º Ö¸¶¨µÄÐУ»
' pathAndFile£º Îļþ·¾¶
'³ÌÐòÊä³ö£º¶ÁÈ¡µÄÖ¸¶¨µ¥Ôª¸ñµÄÖµ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2008-11-05
'µ÷ÓþÙÀý£º Msgbox getCellValue("Ö¸¶¨Ò³",3,4,"D:\test.xls")
'**************************************************************************
********************************************************************
Public Function getCellValue(sheet, row, column, pathAndFile)
Set Wshshell = CreateObject("Wscript.shell")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set ExcelApp = CreateObject("excel.Application")
ExcelApp.Visible = False
If Fso.FileExists(pathAndFile) = True Then
Set newBook = ExcelApp.Workbooks.Open(pathAndFile,False,True)
Set excelSheet = newBook.Worksheets(sheet)
excelSheet.Activate
GetCellValue = excelSheet.Cells(row, column)
Set excelSheet = Nothing
Else
Reporter.ReportEvent
micFail,"δÕÒµ½Îļþ","Ö¸¶¨Îļþ£º¡¾"&originalDataFile&"¡¿Î´ÕÒµ½£¬ÇëÈ·ÈÏ
Îļþ·¾¶£¡"
Print "Ö¸¶¨Îļþ£º¡¾"&originalDataFile&"¡¿Î´ÕÒµ½£¬ÇëÈ·ÈÏÎļþ·¾¶£¡"
End If
ExcelApp.Quit
Set ExcelApp = Nothing
Set Fso = Nothing
Set Wshshell = Nothing
End Function
'**************************************************************************
********************************************************************
'Éè¼Æ˵Ã÷£º¶ÁÈ¡ÒÔIE´ò¿ªµÄEXCELÖ¸¶¨ÐкÍÁеÄÖµ
'³ÌÐòÊäÈ룺

' row£º Ö¸¶¨ÐУ»
' col£º Ö¸¶¨µÄÐУ»
' url£º IEµØÖ·url£¬Ò»°ã¿ÉʹÓÃÕýÔò±í´ïʽÀ´Ê¶±ð;
' tit£º ÍøÒ³±êÌâ
'³ÌÐòÊä³ö£º¶ÁÈ¡µÄÖ¸¶¨µ¥Ôª¸ñµÄÖµ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2008-11-05
'µ÷ÓþÙÀý£º Msgbox
ieXlsValue(3,4,"http://ehis-nbs-stg.paic.com.cn/ehis/.*","^.*½¡¿µÏÕ.*")
'**************************************************************************
********************************************************************
Public Function ieXlsValue(row, column, url,tit)
on error resume Next
Set Wshshell = CreateObject("Wscript.shell")
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate url
If Browser("title:="&tit).Exist(2) Then
Browser("title:="&tit).WinButton("Name:=´ò ¿ª").Click
End If
For v = 1 To 5
If Dialog("Name:=Microsoft Excel").Exist(1) Then
Dialog("Name:=Microsoft Excel").WinButton("Name:=È·¶¨").Click
End If
Next
Set ExcelApp = Getobject(0,"excel.Application")
If Err = 0 Then
Set excelSheet = ExcelApp.ActiveSheet
excelSheet.Activate
GetCellValue = excelSheet.Cells(row, column)
Set excelSheet = Nothing
Else
Print "Îļþ²»´æÔÚ£¡ÇëÈ·ÈÏIEÖÐÒѾ­´ò¿ªEXCELÒ³£¡"
End If
ExcelApp.Quit
Set ExcelApp = Nothing
Set Wshshell = Nothing
Set IE = Nothing
End Function
'**************************************************************************
********************************************************************
'Éè¼Æ˵Ã÷£ºÐ´Èë´¿Îı¾TXTÎļþ
'³ÌÐòÊäÈ룺
' filepath£º Îļþ·¾¶ºÍÎļþÃû×éºÏ£»
' text£º дÈëÖµ
'³ÌÐòÊä³ö£ºÐ´Èëtxt£¬ÎÞÐè·µ»ØÖµ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2008-11-05
'µ÷ÓþÙÀý£º Call txtWrite("D:\test.txt","дÈëʲôֵ")
'**************************************************************************
********************************************************************
Public Sub txtWrite(filepath,text)
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile(filepath, True)
MyFile.Write(text)
MyFile.Close
Set MyFile = nothing

Set fso = nothing
End Sub
'**************************************************************************
********************************************************************
'Éè¼Æ˵Ã÷£º¶ÁÈ¡Õû¸ötxtÎı¾ÎļþµÄÖµ
'³ÌÐòÊäÈ룺filepath£ºtxtÎı¾ÎļþËùÔÚ·¾¶ºÍÎļþÃûµÄ×éºÏ
'³ÌÐòÊä³ö£ºÕû¸öTXTÎļþµÄÄÚÈÝ¡£
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2008-11-05
'µ÷ÓþÙÀý£º Msgbox txtRead("D:\text.txt")
'**************************************************************************
********************************************************************
Public Function txtReadAll(rfilepath)
Const ForReading = 1, ForWriting = 2
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.OpenTextFile(rfilepath, ForReading)
txtRead = MyFile.readAll
Set MyFile = nothing
Set fso = nothing
End Function
'**************************************************************************
********************************************************************
'Éè¼Æ˵Ã÷£º´Ó´ÅÅÌÉÏɾ³ýÖ¸¶¨txtÎı¾Îļþ
'³ÌÐòÊäÈ룺filepath£ºtxtÎı¾ÎļþËùÔÚ·¾¶ºÍÎļþÃûµÄ×éºÏ
'³ÌÐòÊä³ö£ºÉ¾³ý²Ù×÷¹ý³Ì£¬ÎÞÐè·µ»Ø
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2008-11-05
'µ÷ÓþÙÀý£º Call txtDelete("D:\text.txt")
'**************************************************************************
********************************************************************
Public Sub txtDelete(filepath)
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile(filepath)
Set fso = Nothing
End Sub
'**************************************************************************
********************************************************************
'Éè¼Æ˵Ã÷£ºÖ¸¶¨ÉÏÔØÎļþÖÐÌض¨×Ö·ûºóÖ¸¶¨³¤¶ÈµÄ×Ö·ûʹÓÃÁíÒ»Ö¸¶¨×Ö·ûÌæ»»£¬ÖðÐÐ
´¦Àí¡¢Ö±ÖÁ½áÊø£¨ÌÞ³ýÊ×ÐУ©
'³ÌÐòÊäÈ룺
' FilePath£º Îļþ·¾¶
' FileName£º ÎļþÃû³Æ
' SpecifiedStrMark£º Ö¸¶¨×Ö·û
' replaceLength£º Ìæ»»³¤¶È
' ReplaceWith£º ÓÃÀ´Ìæ»»µÄ´®
'³ÌÐòÊä³ö£ºÉ¾³ý²Ù×÷¹ý³Ì£¬ÎÞÐè·µ»Ø
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2008-11-05
'µ÷ÓþÙÀý£º Call
ReplaceStr(FilePath,FileName,SpecifiedStrMark,replaceLength,ReplaceWith)
'**************************************************************************
********************************************************************
Public Sub

ReplaceStr(FilePath,FileName,SpecifiedStrMark,replaceLength,ReplaceWith)
If len(ReplaceWith) <> Abs(replaceLength) Then
Reporter.ReportEvent
micFail,"²ÎÊýʹÓôíÎó","ÇëÈ·ÈÏÐèÒªÌæ»»µÄ³¤¶ÈÓëеÄÌæ»»×Ö·û´®³¤¶ÈÒ»Ö£¡"
Print "²ÎÊýʹÓôíÎó:ReplaceWith²ÎÊý³¤¶ÈÒªÓëreplaceLengthÖµÒ»Ö£¡"
Exit Sub
End If
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set Fso = CreateObject("Scripting.FileSystemObject")
If Not Fso.FileExists(FilePath&FileName) Then
Reporter.ReportEvent
micFail,"²ÎÊýʹÓôíÎó","ÇëÈ·ÈÏÖ¸¶¨µÄÎļþÊÇ·ñ´æÔÚ£¡"
Print
"²ÎÊýʹÓôíÎó:"&FilePath&FileName&"£¬ÇëÈ·ÈϸÃÖ¸¶¨µÄÎļþÊÇ·ñ´æÔÚ£¡"
Exit Sub
End If
Set MyOldFile = fso.OpenTextFile(FilePath&FileName, ForReading)
If Fso.FileExists(FilePath&"temp.txt") Then
Fso.DeleteFile(FilePath&"temp.txt")
End If
Set tmpFile = Fso.CreateTextFile(FilePath&"temp.txt",True)
v = 1
While Not MyOldFile.AtEndOfStream
orgStr = MyOldFile.readLine
If v > 1 Then
If instr(orgStr,SpecifiedStrMark) > 0 Then
timeMark =
Mid(orgStr,instr(orgStr,SpecifiedStrMark)+len(SpecifiedStrMark),r
eplaceLength)
newStr = Replace(orgStr,timeMark,ReplaceWith)
tmpFile.WriteLine(newStr)
Else
tmpFile.WriteLine(orgStr)
End If
Else
tmpFile.WriteLine(orgStr)
End If
v = v + 1
Wend
tmpFile.Close
MyOldFile.Close
Set tmpFile = Nothing
Set MyOldFile = Nothing
Set MyNewFile = Fso.OpenTextFile(FilePath&FileName, ForWriting)
Set MyTemFile = Fso.OpenTextFile(FilePath&"temp.txt", ForReading)
transStr = MyTemFile.ReadAll
MyNewFile.Write (transStr)
MyNewFile.Close
MyTemFile.Close
Fso.DeleteFile(FilePath&"temp.txt")
Set MyTemFile = Nothing
Set MyNewFile = Nothing
Set Fso = Nothing
End Sub
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£ºµÍ¼¶Ëã·¨¼ÓÃÜ£ºÃÜÂëÃ÷ÎļÓÃÜ£¬ASCII¼ÓËæ»úÕûÊýÆ´×°£¬ÈçÓÐÐèÒª¿ÉÖ±½Ó
дÈëTXT»òEXCELÎļþÖÐÈ¥¡£
'³ÌÐòÊäÈ룺ÃÜÂëÃ÷ÎÄ

'³ÌÐòÊä³ö£º¼ÓÃÜ×Ö·û´®
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2008-11-05
'µ÷ÓþÙÀý£ºmsgbox to_num("aaaaa888")
'**************************************************************************
*****************************************************
Public Function to_num(password)
Set Wshshell = Createobject("wscript.shell")
n = len(password)
i = 1
str = ""
Do while i <= n
If len(asc(mid(password,i,1))) = 1 Then
tran = "00"&asc(mid(password,i,1))
Elseif len(asc(mid(password,i,1))) = 2 Then
tran = "0"&asc(mid(password,i,1))
Else
tran = asc(mid(password,i,1))
End If
rank1 = Int(8*Rnd+1)
rank2 = Int(25*Rnd + 65)
char = (rank1-1)&chr(rank2)&rank1&chr(rank2+1)&(rank1+1)
str = str&tran&char
i = i + 1
Loop
to_num = str
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£ºÈçÉÏto_num¼ÓÃܺ¯ÊýµÄ¶ÔÓ¦½âÃܺ¯Êý
'³ÌÐòÊäÈ룺str£ºÃÜÎÄ×Ö·û´®
'³ÌÐòÊä³ö£ºÔ­Ê¼ÃÜÂëÃ÷ÎÄ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2008-11-05
'µ÷ÓþÙÀý£ºmsgbox
openText("0975N6O70974H5I60972T3U40970T1U20976R7S80560K1L20566T7U80562Y3Z4"
)'
**************************************************************************
*****************************************************
Public Function openText(str)
n = len(str)/8
res = ""
Do
n = len(str)/8
char = chr(mid(str,1,3))
str = right(str,8*n-8)
res = res&char
If n = 1 Then
Exit Do
End If
Loop
openText = res
End Function
'**************************************************************************
************************************************************
'Éè¼Æ˵Ã÷£º²éÕÒÖ¸¶¨½ø³Ì

'³ÌÐòÊäÈ룺½ø³ÌÃû³Æ£¬ÈçEXCEL.EXE
'³ÌÐòÊä³ö£º³É¹¦»òÕßʧ°ÜTrue/False
'Éè¼ÆÈËÔ±£ºLIUYI027/PAICDOM
'Éè¼Æʱ¼ä£º2010-01-05
'µ÷ÓþÙÀý£ºMsgbox GetProcess("EXCEL")»òmsgbox GetProcess("EXCEL.EXE")
'**************************************************************************
************************************************************
Public Sub GetProcess(prcessName)
Set bjWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set Processes = objWMIService.ExecQuery("select * from Win32_Process")
For Each Process In Processes
If InStr(UCase(Process.Name),UCase(prcessName)) > 0 Then
GetProcess = True
Else
GetProcess = False
End If
Next
Set Process = Nothing
Set bjWMIService = Nothing
End Sub
'**************************************************************************
************************************************************
'Éè¼Æ˵Ã÷£ºÓÃÓÚ½«½ø³ÌÇ¿Ðйرգ¬³£ÓÃÓïEXCEL½ø³Ì´¦Àí
'³ÌÐòÊäÈ룺½ø³ÌÃû³Æ£¬ÈçEXCEL.EXE
'³ÌÐòÊä³ö£º¹Ø±Õ¶ÔÓ¦µÄ½ø³Ì
'Éè¼ÆÈËÔ±£ºLIUYI027/PAICDOM
'Éè¼Æʱ¼ä£º2010-01-05
'µ÷ÓþÙÀý£ºCall KillProcess("EXCEL")»òCall KillProcess("EXCEL.EXE")
'**************************************************************************
************************************************************
Public Sub KillProcess(prcessName)
If Len(prcessName) < 3 Then
Report
Warning,"ʹÓú¯ÊýKillProcessÊäÈë½ø³ÌÃû³Æ¹ý¶Ì","¹ý¶ÌµÄ½ø³ÌÃû³Æ¿ÉÄÜ»áÆ¥Åä
µ½¶à¸ö½ø³Ì£¬²Ù×÷½«·Ç³£Î£ÏÕ£¬ÇëÍ£Ö¹²Ù×÷£¡"
Exit Sub
End If
Set bjWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set Processes = objWMIService.ExecQuery("select * from Win32_Process")
For Each Process In Processes
If InStr(UCase(Process.Name),UCase(prcessName)) > 0 Then
SystemUtil.CloseProcessByName(Process.Name)
Report
Done,"ϵͳ³öÏÖ"&UCase(prcessName)&"½ø³ÌÒì³£","¸Ã½ø³ÌÒѾ­Ê¹Óú¯ÊýKillP
rocessÇ¿Ðйرգ¡"
End If
Next
Set Process = Nothing
Set bjWMIService = Nothing
End Sub
'**************************************************************************
************************************************************
'Éè¼Æ˵Ã÷£º½â¾ö¿ìËÙÔËÐÐÖеÍÓÚ1ÃëµÄµÈ´ý
'³ÌÐòÊäÈ룺ѭ»·´ÎÊý£¬Ã¿´ÎÑ­»·´óÔ¼11.6ºÁÃë
'³ÌÐòÊä³ö£ºÎÞ

'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2010-12-13
'µ÷ÓþÙÀý£ºDelay 1000´óÔ¼µÈ´ý8Ã룬Delay 100´óÔ¼µÈ´ý1.157Ãë
'**************************************************************************
************************************************************
Public Sub Delay(i)
For x = 0 to i
a = x
Next
End Sub
'**************************************************************************
************************************************************
'Éè¼Æ˵Ã÷£ºÐÞ¸ÄIE8µÄ×¢²áÐÅÏ¢ÒÔ±ãÓÚÔËÐÐ
'³ÌÐòÊäÈ룺ÎÞ
'³ÌÐòÊä³ö£ºÎÞ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2010-12-31
'µ÷ÓþÙÀý£ºCall ModIERegForAutoMation()
'**************************************************************************
************************************************************
Public Sub ModIERegForAutomation
Set bjShell = CreateObject("WScript.Shell")
'ÏÔʾ²Ëµ¥À¸
objShell.RegWrite "HKCU\Software\Microsoft\Internet
Explorer\Main\AlwaysShowMenus",1,"REG_DWORD"
'ÏÔʾÊղؼÐÀ¸
objShell.RegWrite "HKCU\Software\Microsoft\Internet
Explorer\LinksBar\Enabled",1,"REG_DWORD"
'²Ëµ¥À¸Öö¥
objShell.RegWrite "HKCU\Software\Microsoft\Internet
Explorer\Toolbar\WebBrowser\ITBar7Position",1,"REG_DWORD"
'Óöµ½µ¯³ö´°¿ÚʱʼÖÕÔÚÐÂÑ¡ÏÖдò¿ªµ¯³ö´°¿Ú
objShell.RegWrite "HKCU\Software\Microsoft\Internet
Explorer\TabbedBrowsing\PopupsUseNewWindow",1,"REG_DWORD"
'ÆäËû³ÌÐò´Óµ±Ç°´°¿ÚµÄÐÂÑ¡Ï´ò¿ªÁ¬½Ó
objShell.RegWrite "HKCU\Software\Microsoft\Internet
Explorer\TabbedBrowsing\ShortcutBehavior",0,"REG_DWORD"
Set bjShell = Nothing
End Sub
'**************************************************************************
************************************************************
'Éè¼Æ˵Ã÷£º»ñÈ¡IP/ÓòÃûpingµÄ½á¹ûÐÅÏ¢
'³ÌÐòÊäÈ룺±»pingµÄIP»òÕßÓòÃû
'³ÌÐòÊä³ö£ºTrue³É¹¦¡¢Falseʧ°Ü
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-12-13
'µ÷ÓþÙÀý£ºCall GetPingResult("www.google.com")
'**************************************************************************
************************************************************
Function GetPingResult(pingedHost)
Set Ping = GetObject("winmgmts:").ExecQuery ("select * from
Win32_PingStatus where address = '" & pingedHost & "'")
For Each oRetStatus In oPing
If ISNULL(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then
GetPingResult = False

Else
GetPingResult = True
End If
Next
Set Ping = Nothing
End Function
'**************************************************************************
************************************************************
'Éè¼Æ˵Ã÷£ºÊ¹ÓÃÓʼþ·þÎñÆ÷·¢ËÍÓʼþ
'³ÌÐòÊäÈ룺²Î¼ûº¯Êý¶¨Ò壬·Ç³£Óú¯Êý£¬²»×ö׸Êö
'³ÌÐòÊä³ö£º·¢³öÓʼþ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2010-12-13
'µ÷ÓþÙÀý£ºCall
SendMail(mailFrom,mailSmtp,sendUserName,sendUserPassword,mailTo,mailSubject
,mailBody,mailAttachment)
'**************************************************************************
************************************************************
Function
SendMail(mailFrom,mailSmtp,sendUserName,sendUserPassword,mailTo,mailSubject
,mailBody,mailAttachment)
Const conSendUsing
="http://schemas.microsoft.com/cdo/configuration/sendusing"
Const conServer
="http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const conServerPort
="http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const conConnectionTimeout
="http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const conAuthenticate
="http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const conUsessl
="http://schemas.microsoft.com/cdo/configuration/smtpusessl"
Const conSendUserName
="http://schemas.microsoft.com/cdo/configuration/sendusername"
Const conSendPassword
="http://schemas.microsoft.com/cdo/configuration/sendpassword"
Const conPickupPackage
="http://schemas.microsoft.com/cdo/configuration/smtpserverpickupdirector
y"
Set bjMessage = CreateObject("CDO.Message")
Set bjConfig = CreateObject("CDO.Configuration")
Set Fields = objConfig.Fields
Set objMessage.Configuration = objConfig
With Fields
.Item(conSendUsing) = 1 '2ΪʹÓÃÍⲿSMTP·þÎñÆ÷,²»Òª¸ü¸Ä
.Item(conServer) = mailSmtp '¸Ä³É¿ÉÓõÄÍⲿÓʼþ·þÎñÆ÷ÓòÃû
.Item(conPickupPackage) = "C:\Inetpub\mailroot\pickup"
'Èç¹ûʹÓÃÍⲿsmtp·þÎñÆ÷£¬Ôò²»ÐèÒªÅäÖôËÖµ
.Item(conServerPort) = 25
'ÍⲿSMTP·þÎñÆ÷¶Ë¿Ú,gmailʹÓÃ465,ÆäËüÒ»°ãʹÓÃ25
.Item(conConnectionTimeout) = 10 'É趨Á¬½Ó³¬Ê±£¬µ¥Î»Ãë
.Item(conUsessl) = False
'ÊÇ·ñʹÓÃSSL°²È«Ì×½Ó×Ö£¬gmailΪtrue£¬ÆäËüÒ»°ãfalse
.Item(conAuthenticate) = 1 '1Ϊ·¢ËÍÓʼþÐèÒªÈÏÖ¤,ͨ³£²»Òª¸ü¸Ä

.Item(conSendUserName) = sendUserName
.Item(conSendPassword) = sendUserPassword
.Update
End With
With objMessage
.To = Trim(mailTo) '¸Ä³É½ÓÊÕÕßµÄÓʼþµØÖ·
.From = mailFrom
'¸Ä³É·¢ËÍÈ˵ÄÓʼþµØÖ·,ÒªºÍÉÏÃæµÄÓʼþϵͳÏàͬ
.Subject = Trim(mailSubject) '±êÌâ
.HTMLBody = "<html><head><meta. http-equiv=""Content-Type""
content=""text/html; charset=Shift_JIS"" /></head>"&_
"<body>"&mailBody&"</body></html>" 'HTMLÓʼþÕýÎÄ
.BodyPart.Charset = "Shift_JIS" 'Óʼþ±àÂë
.HTMLBodyPart.Charset="Shift_JIS" 'ÓʼþHTML¸ñʽ±àÂë
If Trim(mailAttachment) <> "" Then
.AddAttachment mailAttachment 'Óʼþ¸½¼þ
End If
.Send
End With
Set bjMessage = Nothing
Set bjConfig = Nothing
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º¸ù¾ÝÈÕÆÚ¡¢Ê±¼äºÍÁ½×éËæ»úÊýÉú³ÉÏà¶Ô½ÏΪΨһµÄ×Ö·û´®£¬³£ÓÃÓÚÎļþµÄ
·Ç¸²¸Ç±£´æ
'³ÌÐòÊäÈ룺ѭ»·´ÎÊý£¬¶ÔÓÚÊäÈë´íÎóµÄ×Ö·û´®£¬½ØÈ¡µÚһλת»»Îª¶ÔÓ¦µÄASCIIÊý×Ö
×÷Ϊѭ»·×î´ó´ÎÊý
'³ÌÐòÊä³ö£ºÈÕÆÚ¡¢Ê±¼ä¡¢Ëæ»úÊý¡¢Ëæ»úÊýµÄÆ´½Ó×Ö·û´®È磺20110107_161003_93778_
47149
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-07
'µ÷ÓþÙÀý£ºPrinter GenerateUniqueStr("30")
'**************************************************************************
*****************************************************
Public Function GenerateUniqueStr(p_circle)
If Trim(p_circle) = "" Then
p_circle = randomnumber.Value(11,99)
Else
If isNumeric(p_circle) = False Then
p_circle = ASC(Left(p_circle,1))
If p_circle < 11 Then
p_circle = p_circle + 11
End If
Else
p_circle = Trim(p_circle)
End If
End If
randomNo = randomnumber.Value(10,Abs(p_circle))
For i = 1 to randomNo
randomNum1 = randomnumber.Value(10000,99999)
randomNum2 = Int((99999-10000+1)*rnd+10000)
Next
GenerateUniqueStr =
FormatDate(Now,"yyyymmdd_hh24miss")&"_"&randomNum1&"_"&randomNum2
End Function

'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º£¨Ä£·ÂPL/SQLµÄto_char(ÈÕÆÚ)º¯Êý£©°ÑÈÕÆÚ/ʱ¼äֵת»¯³ÉÖ¸¶¨¸ñʽµÄ×Ö
·û´®
'³ÌÐòÊäÈ룺ÈÕÆÚ£¨µ±Ç°ÈÕÆÚ£©
'³ÌÐòÊä³ö£º¹Ì¶¨¸ñʽµÄÈÕÆÚ£ºÄê¸ñʽYYYY£¬ÔÂMM£¬ÈÕDD£¬Ê±HH£¬·Ömm£¬Ã룬SS
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-04
'µ÷ÓþÙÀý£ºmsgbox FormatDate(date&time,'yyyy-mm-dd')
'**************************************************************************
*****************************************************
Function FormatDate(p_date, p_format)
Set parts= CreateObject("Scripting.Dictionary")
parts("yyyy") = CStr(Year(p_date))
parts("yy") = Right(Year(p_date), 2)
parts("mm") = Lpad(Month(p_date), 2, "0")
parts("mi") = Lpad(Minute(p_date), 2, "0") '
Éè¼ÆÔ­Òò£¬°üº¬mµÄ±ØÐë·ÅÔÚmonth֮ǰ
parts("m") = CStr(Month(p_date))
parts("dd") = Lpad(Day(p_date), 2, "0")
parts("d") = CStr(Day(p_date))
parts("hh24") = Lpad(Hour(p_date), 2, "0")
parts("ss") = Lpad(Second(p_date), 2, "0")
v_result = p_format
For Each part In parts
v_result = Replace(v_result, part, parts(part))
Next
FormatDate = v_result
Set parts = Nothing
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º£¨Ä£·ÂPL/SQLͬÃûº¯Êý£©½«p_str³¤¶ÈÀ©Õ¹µ½p_width£¬ÓÃp_filling´Ó×ó
±ßÑ­»·Ìî³ä£¬±¾º¯Êý²»»á½Ø¶Ìp_str
'³ÌÐòÊäÈ룺
'³ÌÐòÊä³ö£º
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-04
'µ÷ÓþÙÀý£ºmsgbox Lpad(Second(p_date), 2, "0")
'**************************************************************************
*****************************************************
Function Lpad(p_str, p_width, p_filling)
Lpad = ExpandString(p_filling, p_width - Len(p_str)) & p_str
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º£¨Ä£·ÂPL/SQLͬÃûº¯Êý£©½«p_str³¤¶ÈÀ©Õ¹µ½p_width£¬ÓÃp_filling´Ó×ó
±ßÑ­»·Ìî³ä£¬±¾º¯Êý²»»á½Ø¶Ìp_str
'³ÌÐòÊäÈ룺
'³ÌÐòÊä³ö£º
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-04

'µ÷ÓþÙÀý£ºmsgbox Lpad(Second(p_date), 2, "0")
'**************************************************************************
*****************************************************
Function Rpad(p_str, p_width, p_filling)
Rpad = p_str & ExpandString(p_filling, p_width - Len(p_str))
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º½«p_str·´¸´µþ¼Ó£¬Ê¹Æ䳤¶ÈÀ©Õ¹£¨»òËõС£©µ½p_width
'³ÌÐòÊäÈ룺
'³ÌÐòÊä³ö£º
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-04
'µ÷ÓþÙÀý£ºExpandString("bye",7) ·µ»Ø byebyeb £» ExpandString("bye",2)·µ»Ø
by
'**************************************************************************
*****************************************************
Private Function ExpandString(p_str, p_width)
Dim width0, repeat_times, reminder, i, result
If p_width <= 0 Then
ExpandString = ""
Exit Function
End If
width0 = Len(p_str)
repeat_times = p_width \ width0
reminder = p_width Mod width0
For i = 1 To repeat_times
result = result & p_str
Next
result = result & Left(p_str, reminder)
ExpandString = result
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º´Óp_strµÄÓÒ±ßÈ¥³ýto_trimÖÐ*°üº¬*µÄ×Ö·û
'³ÌÐòÊäÈ룺
'³ÌÐòÊä³ö£º
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-04
'µ÷ÓþÙÀý£ºRReplaceExp("1234ABC5678","0123456789")·µ»Ø"1234ABC"
'**************************************************************************
*****************************************************
Function RReplaceExp(p_str, to_Trim)
Dim s, c
s = p_str
Do While True
c = Right(s, 1)
If InStr(to_Trim, c) > 0 Then
s = Left(s, Len(s) - 1)
Else
Exit Do
End If

Loop

RReplaceExp = s
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º´Óp_strµÄ×ó±ßÈ¥³ýto_trimÖÐ*°üº¬*µÄ×Ö·û
'³ÌÐòÊäÈ룺
'³ÌÐòÊä³ö£º
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-04
'µ÷ÓþÙÀý£ºLReplaceExp("1234ABC5678","0123456789")·µ»Ø"ABC5678"
'**************************************************************************
*****************************************************
Function LReplaceExp(p_str, to_Trim)
Dim s, c
s = p_str
Do While True
c = Left(s, 1)
If InStr(to_Trim, c) > 0 Then
s = Right(s, Len(s) - 1)
Else
Exit Do
End If
Loop
LReplaceExp = s
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£ºÅжÏstrÊÇ·ñÆ¥ÅäÕýÔò±í´ïʽpattern£¬¿ÉÒÔÖ¸¶¨ÊÇ·ñÑϸñÆ¥Åä´óСд
'³ÌÐòÊäÈ룺
'³ÌÐòÊä³ö£º
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-04
'µ÷ÓþÙÀý£ºismatch("hello","^h.*o$",true) ·µ»Øtrue
'**************************************************************************
*****************************************************
Function isMatch(str, pattern, caseStrict)
Dim regex
set regex = New RegExp ' ½¨Á¢ÕýÔò±í´ïʽ¡£
regex.pattern = pattern ' ÉèÖÃģʽ¡£
regex.ignoreCase = not caseStrict ' ÉèÖÃÊÇ·ñÇø·Ö´óСд¡£
isMatch = regex.test(str) ' Ö´ÐÐËÑË÷²âÊÔ¡£
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£ºÕýÔò±í´ïʽÌæ»»
'³ÌÐòÊäÈ룺
'³ÌÐòÊä³ö£º
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-04
'µ÷ÓþÙÀý£ºreplaceReg("helloworld","[aeiou]","") ·µ»Øhllwrld
'**************************************************************************
*****************************************************
Function replaceReg(Str, pattern, replacement)
Dim regex

set regex = New RegExp
regex.pattern = pattern
regex.global = True
replaceReg=regex.replace(Str, replacement)
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£ºÓÃstr_arrayÖеıäÁ¿´úÌætextÖеÄÏàӦλÖõÄ?£¨Îʺţ©
'³ÌÐòÊäÈ룺
'³ÌÐòÊä³ö£º
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-04
'µ÷ÓþÙÀý£ºFormatString("hello ?, I am ?", array("vbs","gaoning")) ·µ»Ø
hello vbs, I am gaoning
'**************************************************************************
*****************************************************
Function FormatString(text, str_array)
Dim texts, i, t, result
texts=split(text,"?")
i=-1
For each t in texts
If i=-1 Then
result=t
Else
result= result & str_array(i) & t
End If
i=i+1
Next
FormatString= result
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º¼ò»¯ReportEventµÄÊéд£¬Òý×ÔSaffron¿ò¼Ü
'³ÌÐòÊäÈ룺½á¹û±¨¸æ״̬
'³ÌÐòÊä³ö£º½á¹û±¨¸æ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-08
'µ÷ÓþÙÀý£ºReport Pass
'**************************************************************************
*****************************************************
Public Function Report (status, objtype, text)
Reporter.Filter = rtEnableAll
Reporter.ReportEvent status, objtype, text
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£º½«×Ö·û´®Á½¶Ë¼ÓÉÏË«ÒýºÅ£¬Òý×ÔSAFFRON¿ò¼Ü
'³ÌÐòÊäÈ룺×Ö·û´®
'³ÌÐòÊä³ö£º¼ÓÁËÒýºÅµÄ×Ö·û´®
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-01-08
'µ÷ÓþÙÀý£ºQuote("AAA")·µ»Ø "AAA"
'**************************************************************************
*****************************************************

Public Function Quote (txt)
Quote = chr(34) & txt & chr(34)
End Function
'**************************************************************************
*****************************************************
'Éè¼Æ˵Ã÷£ºÈ¡×Ö·û»ò×Ö·û´®ÔÚÒ»¸öÊý×éÖеÄλÖã¬Òý×ÔSAFFRON¿ò¼Ü
'³ÌÐòÊäÈ룺Êý×é¡¢×Ö·û´®
'³ÌÐòÊä³ö£ºÎ»ÖÃÐòºÅ
'Éè¼ÆÈËÔ±£º
'Éè¼Æʱ¼ä£º2011-01-08
'µ÷ÓþÙÀý£ºIndexOf(myArray,"something")
'**************************************************************************
*****************************************************
Public Function IndexOf (myArray, str)
val = -1
For i = 0 to UBound(myArray)
If myArray(i) = str Then
val = i
End If
Next
IndexOf = val
End Function
'**************************************************************************
************************************************************
'Éè¼Æ˵Ã÷£º
'
ÅжÏÒ»°ãÐÔµÄjs²ãÅ׳öµÄ¿ØÖÆÌáʾ£¬¸ù¾ÝÓû§Ñ¡ÔñÈçºÎ×öºóÐø´¦Àí£¬Çë×¢Ò⣬¸Ã³ÌÐò
Ö»ÄÜÓÃÓÚÔ¤ÆÚÖ®ÍâµÄÌáʾ´¦Àí£¬Ô¤ÆÚÖ®ÄÚ±ØÐë×ÔÐÐÅжÏ
'
Èç¹û²»¹ØÐÄÒ³ÃæÌáʾÐÅÏ¢ÊÇʲô£¬Ö»Ïë°ÑÌáʾÐÅÏ¢×¥³öÀ´£¬ÄÇôƥÅä¹Ø¼ü×ÖÊäÈë¿ÕÖµ
¼´¿É
'³ÌÐòÊäÈ룺
' respath------½ØͼÎļþ±£´æ·¾¶
'
judgeKeyWord------ÓÃÓÚ½øÐÐÆ¥ÅäµÄ¹Ø¼ü×ÖÐÅÏ¢£¬¿ÉÓÃÓ¢ÎÄ°ë½ÇµÄ¶ººÅ·Ö¸ô£¬Ö»ÓÐËù
Óйؼü¶¼ÔÚÒ³ÃæÕÒµ½²ÅÊÓΪÔËÐÐͨ¹ý
' isExitRun-------¶ÔÓÚÆ¥Åäʧ°ÜµÄÇé¿ö£¬Ñ¡ÔñÊÇ·ñ³¹µ×Í˳öÔËÐÐ
'³ÌÐòÊä³ö£º½ØͼÎļþ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-12-05
'µ÷ÓþÙÀý£ºCall JudgeErrorForDialog("D:\","Çë,µÇ¼","Y")
'**************************************************************************
************************************************************
Public Sub JudgeErrorForDialog(respath,judgeKeyWord,isExitRun)
On Error Resume Next
Set Wshshell = CreateObject("Wscript.Shell")
'ÅжÏÓû§´«Èë²ÎÊý
If Trim(judgeKeyWord) = "" Or judgeKeyWord is Null Then
theKeyArray =
"Óû§Ñ¡Ôñ²»×ö¹Ø¼ü×ÖÆ¥Åä"&Replace(Date,"/","-")&"_"&Replace(Time,":","-"
)
emptyPara = True
End If

theKeyArray = Split(judgeKeyWord,",")
If Trim(Replace(isExitRun,"y","Y")) = "Y" Or isExitRun = True Then
isExitRun = True
ElseIf Trim(Replace(isExitRun,"n","N")) = "N" Or isExitRun = False Then
isExitRun = False
Else
isExitRun = True
Reporter.ReportEvent
micWarning,"Ç뾡Á¿Ê¹Óá¾Y/N¡¿À´×÷ΪÄú²ÎÊý","ÓÉÓÚ±¾´ÎÊäÈëÎÞЧ£¬³ÌÐò½«×Ô
¶¯Ñ¡ÔñÔÚÎÞ·¨ÍêÈ«Æ¥ÅäµÄʱºò×Ô¶¯Í˳öÔËÐУ¬ÇëÁ˽⣡"
End If
'³õʼ»¯ËùÓдò¿ªµÄIE£¬ÒÔ±ãÈ·ÈÏËùÓеĵ¯³ö´°¿Ú¶¼ÒѾ­Õ¹ÏÖÔÚÒ³ÃæÉÏ
Set BrowserObject = Description.Create()
BrowserObject("micclass").Value = "Browser"
Set WindowsBrowser = Desktop.ChildObjects(BrowserObject)
brNum = WindowsBrowser.Count
If brNum < 1 Then
Set WindowsBrowser = Nothing
Set BrowserObject = Nothing
Set Wshshell = Nothing
Exit Sub
Else
For bindex = 0 to brNum - 1
WindowsBrowser(bindex).Sync
Next
End If
Set WindowsBrowser = Nothing
Set BrowserObject = Nothing
Set DialogObject = Description.Create()
DialogObject("micclass").Value = "Dialog"
Set WindowsDialog = Desktop.ChildObjects(DialogObject)
dlNum = WindowsDialog.Count
If dlNum < 1 Then
Set WindowsDialog = Nothing
Set DialogObject = Nothing
Set WindowsBrowser = Nothing
Set BrowserObject = Nothing
Set Wshshell = Nothing
If emptyPara = True Then
Reporter.ReportEvent
micPass,"ûÓÐÐèÒªÅжϵĶÔÏó","Ìá½»Ö®ºóϵͳûÓÐÈκε¯³öµÄÒ³ÃæÐÅÏ¢Ìáʾ
£¡"
Else
Reporter.ReportEvent
micWarning,"ûÓÐÐèÒªÅжϵĶÔÏó","Ìá½»Ö®ºóϵͳûÓÐÈκε¯³öµÄÒ³ÃæÐÅÏ¢Ìá
ʾ£¡"
End If
Exit Sub
End If
For dindex = 0 to dlNum - 1
dlTitle = WindowsDialog(dindex).GetROProperty("text")
nameByTime = GenerateUniqueStr(30)&".png"

fileName =
respath&Environment.Value("TestName")&"_"&Environment.Value("ActionName
")&"_"&nameByTime
'¶ÔÓÚµ¯³öµÄÏÂÔØ´°¿Ú£¬ÐèÒªÓõ¥¶ÀµÄ³ÌÐò´¦Àí£¬´íÎóÅжÏÖв»×ö´¦Àí£¬Ö±½Ó¹Ø±Õ
If INStr(dlTitle,"ÏÂÔØ") > 0 Or INStr(dlTitle,"°²×°") > 0 Or
INStr(dlTitle,"Áí´æΪ") > 0 Or INStr(dlTitle,"±£´æΪ") > 0 Then
WindowsDialog(dindex).Close
End If
'Windows
GUIÖ±½Ó´¦Àíµô£¬²»ÔÚÅжϷ¶Î§Ö®ÄÚ£¬Èç¹ûÐèҪʹÓÃÔòÇë×ÔÐÐÐ޸ģ¨×¢Ê͵ô£©ÕâÒ»
¶Î
Set Win32Object = Description.Create()
Win32Object("micclass").Value = "WinObject"
Set WindowsObject = WindowsDialog(dindex).ChildObjects(Win32Object)
woNum = WindowsObject.Count
If woNum > 0 Then
For windex = 0 to woNum - 1
winMessage = WindowsObject(windex).GetROProperty("text")
If Not Trim(winMessage) = "" Then
Reporter.ReportEvent
micDone,"³ÌÐò²»×öÆ¥ÅäÅжϵÄÌáʾÐÅÏ¢£º",winMessage
End If
Next
Wshshell.AppActivate(dlTitle)
Delay 100
WindowsDialog(dindex).CaptureBitmap fileName
Wshshell.AppActivate(dlTitle)
Delay 400
Wshshell.SendKeys "{ENTER}"
End If
Set WindowsObject = Nothing
Set Win32Object = Nothing
Next
'ÖØÐÂCountÒ³ÃæÉϵķÇÏÂÔØ´°¿Ú¸öÊý
Set WindowsDialog = Nothing
Set WindowsDialog = Desktop.ChildObjects(DialogObject)
diaNum = WindowsDialog.Count
maxCount = 0
For dlindex = 0 to diaNum - 1
dlTitle = WindowsDialog(dlindex).GetROProperty("text")
nameByTime = GenerateUniqueStr(30)&".png"
fileName =
respath&Environment.Value("TestName")&"_"&Environment.Value("ActionName
")&"_"&nameByTime
'¶ÔÓÚµ¯³öµÄÐÅÏ¢Ìáʾ´°¿Ú£¬ÐèÒª»ñÈ¡ÆäÌáʾÐÅÏ¢£¬ÒÔ¹©ºóÐøÑ¡Ôñ´¦Àí·½Ê½
Set StaticObject = Description.Create()
StaticObject("micclass").Value = "Static"
Set WindowsStatic = WindowsDialog(dlindex).ChildObjects(StaticObject)
stNum = WindowsStatic.Count
For sindex = 0 to stNum - 1
disMessage = WindowsStatic(sindex).GetROProperty("text")

arrindex = 0
For arrindex = 0 To UBound(theKeyArray)
If INStr(disMessage,theKeyArray(arrindex)) > 0 Then
maxCount = maxCount + 1
Reporter.ReportEvent micDone,"¹Ø¼ü×ÖÆ¥Åä³É¹¦","¹Ø¼ü×Ö¡¾
"&theKeyArray(arrindex)&" ¡¿Æ¥Åä³É¹¦£¡"
End If
arrindex = arrindex + 1
Next
Next
Wshshell.AppActivate(dlTitle)
Delay 100
WindowsDialog(dlindex).CaptureBitmap fileName
Wshshell.AppActivate(dlTitle)
Delay 400
Wshshell.SendKeys "{ENTER}"
Next
If maxCount < UBound(theKeyArray) + 1 Then
Reporter.ReportEvent
micFail,"º¯Êý¡¾JudgeErrorForDialog¡¿¹Ø¼ü×ÖÆ¥Åäʧ°Ü","ÄúÐèҪƥÅ䡾
"&(UBound(theKeyArray) + 1)&" ¡¿¸ö¹Ø¼ü×Ö£¬Ò³ÃæÉϳöÏÖÁË¡¾ "&maxCount&"
¡¿¸ö£¡"
If isExitRun = True Then
Set WindowsStatic = Nothing
Set StaticObject = Nothing
Set WindowsDialog = Nothing
Set DialogObject = Nothing
Set Wshshell = Nothing
ExitRun
End If
Else
Reporter.ReportEvent
micPass,"º¯Êý¡¾JudgeErrorForDialog¡¿¹Ø¼ü×ÖÆ¥Åä³É¹¦","ÄúÐèҪƥÅ䡾
"&(UBound(theKeyArray) + 1)&" ¡¿¸ö¹Ø¼ü×Ö£¬Ò³ÃæÉϳöÏÖÁË¡¾ "&maxCount&"
¡¿¸ö£¡"
End If
Set WindowsStatic = Nothing
Set StaticObject = Nothing
Set WindowsDialog = Nothing
Set DialogObject = Nothing
Set Wshshell = Nothing
End Sub
'**************************************************************************
************************************************************
'Éè¼Æ˵Ã÷£º
'
Ò³ÃæÅ׳öδ·â×°µÄRuntimeExcptions£¬Ò»°ãÊÇÓ¦Óóö´í»òÕß»·¾³Òì³£ËùÖ£¬¶ÔÓÚÕâÖÖ
Çé¿ö³ÌÐòÖ±½Ó½Øͼ֮ºóÍ˳öÔËÐУ¬²»¿ÉÑ¡Ôñ
'
²»Í¬ÏµÍ³Ê¹Óÿª·¢µÄÏ°¹ßÓÐËù²»Í¬£¬ÀýÈçÓÐʹÓÃWebTable´æ·Å´íÎóÐÅÏ¢£¬ÓÐʹÓÃÒ³Ãæ
¶ÌÎı¾½áºÏLinkÏêϸÎı¾µÄ·½Ê½£¬Çë×ÔÖ÷¸ÄÔì
'³ÌÐòÊäÈ룺
' respath------½ØͼÎļþ±£´æ·¾¶
'
myKeyWords------ÓÃÓÚ½øÐÐÆ¥ÅäµÄ¹Ø¼ü×ÖÐÅÏ¢£¬¿ÉÓÃÓ¢ÎÄ°ë½ÇµÄ¶ººÅ·Ö¸ô£¬Ö»ÒªÓÐÈÎ

Òâ¹Ø¼ü×ÖÔÚÒ³ÃæÕÒµ½¶¼ÊÓΪ·¢ÏÖÒì³££¬ÔËÐÐÍ˳ö
'³ÌÐòÊä³ö£º½ØͼÎļþ
'Éè¼ÆÈËÔ±£ºLIUYI027
'Éè¼Æʱ¼ä£º2011-12-05
'µ÷ÓþÙÀý£ºCall
JudgePageExceptions("D:\","Excetion,EXCEPTION,exception,ORA-,ÏêϸÇé¿ö")
'**************************************************************************
************************************************************
Public Sub JudgePageExceptions(respath,myKeyWords)
On Error Resume Next
Set Wshshell = CreateObject("Wscript.Shell")
'ÒòΪһµ©³ö´íÁ¢¿ÌÍ£Ö¹ÔËÐУ¬²»»á³öÏÖ¶à´Î½Øͼµ¼ÖµÄÎļþÃû³åÍ»£¬¹ÊÎļþÃûÖ»¸³
Ò»´ÎÖµ
nameByTime = GenerateUniqueStr(30)&".png"
fileName =
respath&Environment.Value("TestName")&"_"&Environment.Value("ActionName")
&"_"&nameByTime
'Èç¹ûÊäÈëΪ¿Õ£¬Ôò×éºÏÒ»¸ö²»´ó¿ÉÄܳöÏֵĴíÎóÐÅÏ¢³öÀ´£¬Ïë±Ø²»»áÄĸöϵͳ³öÕâ
ÖÖExceptionµÄ£º£©
If Trim(myKeyWords) = "" Or myKeyWords is Null Then
myKeyWords =
myKeyWords&"Óû§Ñ¡Ôñ²»×ö¹Ø¼ü×ÖÆ¥Åä"&Replace(Date,"/","-")&"_"&Replace(T
ime,":","-")
End If
theKeyArray = Split(myKeyWord,",")
Set BrowserObj = Description.Create()
BrowserObj("micclass").Value = "Browser"
Set Win32Browser = Desktop.ChildObjects(BrowserObj)
brNum = Win32Browser.Count
If brNum < 1 Then
Set WindowsBrowser = Nothing
Set BrowserObject = Nothing
Set Wshshell = Nothing
Exit Sub
End If
For bindex = 0 to brNum - 1
Win32Browser(bindex).Sync
Set PageObj = Description.Create()
PageObj("micclass").value = "Page"
Set Win32Page = Win32Browser(bindex).ChildObjects(PageObj)
pgNum = Win32Page.Count
For pindex = 0 to pgNum - 1
Set FrameObj = Description.Create()
FrameObj("micclass").Value = "Frame"
Set Win32Frame. = Win32Page(pindex).ChildObjects(FrameObj)
frNum = Win32Frame.Count
'¶ÔÓÚÒ³ÃæÉϵijö´íÐÅÏ¢£¬Èç¹û´æÔÚʹÓÃLINKÁ´½ÓµÄ´íÎóÎı¾ÐÅÏ¢Ôòµã¿ª²¢ÇÒ½Ø
ͼ£¬Á´½ÓÃû³ÆΪÐèҪƥÅäµÄ¹