|
|
对于如何读取一个对象的Data，RRAFS里有一个函数
Function DDGGetGUIObjectData (guiID As String, values() As Variant, Optional dataTest As Variant) As Integer
Const OBJECT_DATA_VP = "objectdata"
Const VPTYPE = "grd"
Const VPEXT = ".grd"
Const VPBASEEXT = ".base.grd"
Const VPEXPEXT = ".exp.grd"
Const VPACTUAL = ".act*"
CONST VPMEXT = ".vpm"
Const DEFAULT_DATA_TEST = "Contents"
Dim status As Integer
Dim vpbase As String
Dim vpvpm as String
Dim vpvpm2 as String
Dim vpexp As String
Dim vpact as String
Dim tpath As String
Dim actual as Integer
Dim vpDataTest As String
' what object data to capture?
If IsMissing(dataTest) Then
vpDataTest = DEFAULT_DATA_TEST
Else
vpDataTest = dataTest
End If
Dim aTemp() as String
Dim aTemp2() as String
Dim record as String
Dim aNull As Integer
Dim row AS Integer, rows as Integer
Dim col AS Integer, cols as Integer, tcols as Integer
On Error Resume Next
DDGGetGUIObjectData = -1
'have SQA give us a valid VP ACTUAL name to use for our dummy VP
vpbase = SQAVpGetCurrentBaselineFileName (OBJECT_DATA_VP, VPTYPE)
'SQACONSOLEWRITE "DEBUG: vpbase = "& vpbase
'delete any pre-existing file of same name
Kill vpbase
DoEvents
'copy our objectdata.grd dummy VP to this new ACTUAL filename and location
FileCopy GetDDERuntimeRepo() & OBJECT_DATA_VP & VPEXT, vpbase
'create an appropriate VPM ACTUAL filename from our given filename
vpvpm = FindAndReplace(vpbase, VPBASEEXT, VPMEXT)
'SQACONSOLEWRITE "DEBUG: vpvpm = "& vpvpm
'delete any pre-existing file of same name
Kill vpvpm
DoEvents
'copy our dummy VPM file to this new filename and location
FileCopy GetDDERuntimeRepo() & OBJECT_DATA_VP & VPMEXT, vpvpm
' out dummy VPM file contains the default Data Test value "Contents"
' change that if different data test is specified
If vpDataTest <> DEFAULT_DATA_TEST Then
Dim fin As Integer
fin = FreeFile
Open GetDDERuntimeRepo() & OBJECT_DATA_VP & VPMEXT For Input As #fin
Dim fout As Integer
fout = FreeFile
Open vpvpm For Output As #fout
Dim inline As String
Do While Not EOF(fin)
Line Input #fin, inline
If InStr(inline, "Data Test=") > 0 Then
Print #fout, "Data Test=" & vpDataTest
Else
Print #fout, inline
End If
Loop
Close #fin, #fout
End If
'get a valid VP BENCH filename based on our dummy VP
vpexp= SQAVpGetBaselineFileName (OBJECT_DATA_VP, VPTYPE)
'SQACONSOLEWRITE "DEBUG: vpexp = "& vpexp
'extract the directory information out of the filename
tpath = Mid$(vpexp, 1, LastInStr(vpexp, "\", 1))
'SQACONSOLEWRITE "DEBUG: tpath = "& tpath
'delete any pre-existing file of same name
Kill vpexp
DoEvents
'copy our dummy VPM file to this new BENCH filename and location
FileCopy GetDDERuntimeRepo() & OBJECT_DATA_VP & VPEXT, vpexp
'DEBUG might not need this section at all
vpvpm2 = tpath & GetShortFileName(vpvpm)
if StrComp(vpvpm2, tpath, 1) <> 0 then Kill vpvpm2
DoEvents
'perform the ObjectDataVP to capture the data. ListViewVP should work for all or most
SQASuspendLogOutput
'Window SetContext, winguiID, "Activate=0" 'CANAGL: winguiID parameter removed
status = ListViewVP (CompareData, GUIID, "VP="& OBJECT_DATA_VP)
SQAResumeLogOutput
DoEvents
'delete all our temporary files as quickly as possible
Kill vpbase
Kill vpvpm
Kill vpexp
if StrComp(tpath, vpvpm2, 1) <> 0 then Kill vpvpm2
DoEvents
'determine the path to the ACTUAL filename that was captured
vpact = FindAndReplace(vpexp, VPEXPEXT, VPACTUAL)
'SQACONSOLEWRITE "DEBUG: vpact = "& vpact
'if no actual was created? No error? Or bigger problem?
'we should ALWAYS have an actual because we ALWAYS should fail
'unless a really big problem like "could not even attempt VP" occurs
vpact = Dir$(vpact)
if vpact = "" then EXIT FUNCTION 'with failure
'SQACONSOLEWRITE "DEBUG: DIR(vpact) = "& vpact
vpact = tpath & vpact
'now we need to extract the data and fill the array
actual = FreeFile
Open vpact for Input as #actual
'loop through the ACTUAL file to extract the records
rows = 0
Do Until EOF(actual)
Line Input #actual, record
aNull = Instr(record, Chr(0))
'remove string terminators
If aNull > 0 Then record = Left(record, aNull -1)
If Len(record) > 0 Then
ReDim Preserve aTemp(0 to rows)
aTemp(rows) = record
rows = rows +1
End If
Loop
'close the ACTUAL file
Close #actual
'delete our temporary file
if StrComp(tpath, vpact, 1) <> 0 then Kill vpact 'what if it isn't a filename? only the directory? YIKES!
if rows < 1 then exit function
'determine how wide a 2D array we need
cols = 0
For row = 0 to rows -1
tcols = GetFieldCount(aTemp(row), 1, Chr(9))
if tcols > cols then cols = tcols
Next
Redim values( 1 to rows, 1 to cols)
'extract the data into the array
For row = 1 to rows
record = aTemp(row -1)
tcols = GetFieldArray(record, 1, Chr(9), aTemp2)
For col = 1 to tcols
values(row, col) = aTemp2(col)
Next
Next
On error goto 0
DDGGetGUIObjectData = rows
End Function |
|
/1 
关于我们
发表于 2004-7-5 17:11:51
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
微信
收藏
置顶服务
换色服务
恕小弟愚昧，没太明白）
楼主