'------------------------------------------------------------------------------- ' DIAdem script to export the file format: ' Multimedia data exchange format for impact tests, ISO/TS 13499 (MME) ' ' Version 1.3.2329, channel data, RED A '------------------------------------------------------------------------------- option explicit 'enumerations for enumMode Const eMMEOverwrite = 1 Const eMMENew = 2 'enumerations for enumMsgText Const eMMEMsgFileExists = 1 Const eMMEMsgChnPropErr = 2 Const eMMEMsgPropSource = 3 Const eMMEMsgGroupPropErr = 4 Const eMMEMsgRootPropErr = 5 Const eMMEMsgInvalidProp = 6 Const eMMEMsgSubFolderErr = 7 Const eMMEMsgSubFolderSrc = 8 Const eMMEMsgLogCaption = 9 Const eMMEMsgLogBegin = 10 Const eMMEMsgLogEnd = 11 Const eMMEMsgExportErrors = 12 Const eMMEMsgStatusExporting = 13 Const eMMEMsgStatusLogging = 14 Const eMMEMsgStatusFinished = 15 'standard error number Const clMMEStdError = -1 'text for missing values Const csMMENovalue = "NOVALUE" '------------------------------------------------------------------------------- sub MMEExport( sFilePath) '------- dim eWriteMode : eWriteMode = eMMEOverwrite 'eMMENew '------- dim oErrors dim dLoopFrac '------- dim lPos dim sTestNumber dim sBasePath dim sChnFolder '------- dim sTestDescFilePath dim oTestDescFile '------- dim i dim sChnFilePath dim oChnFile dim lChnCount dim sChnName() dim lPropLoop dim lFixedPropCount dim sPropName dim sDescriptor '------- dim sChnInfoFilePath dim oChnInfoFile '------- dim oNumLocale 'Init variables and DIAdem status and loop display set oNumLocale = new clsNumLocale set oErrors = new clsMMEErrors call MsgLineDisp(MMETextGet(eMMEMsgStatusExporting,sFilePath,"")) call LoopInit dLoopFrac = 100/(GlobUsedChn+3) 'Get test number from MME file name lPos = InStrRev(sFilePath,"\") sTestNumber = right(sFilePath,len(sFilePath)-lPos) sTestNumber = left(sTestNumber,InStrRev(sTestNumber,".")-1) 'Get channel folder sBasePath = left(sFilePath,lPos-1) sChnFolder = sBasePath & "\channel" 'Write Test Derscriptor File sTestDescFilePath = sFilePath set oTestDescFile = new clsMMEDataFile set oTestDescFile.Errors = oErrors call oTestDescFile.create( sTestDescFilePath, eWriteMode) If oTestDescFile.IsOpen then oTestDescFile.PropOptional = False call oTestDescFile.WriteValue( "Data format edition number" ,"1.3" ) call oTestDescFile.WriteRootProp("Laboratory name" ,"Laboratory_name" ) call oTestDescFile.WriteRootProp("Laboratory contact name" ,"Laboratory_contact_name" ) call oTestDescFile.WriteRootProp("Laboratory contact phone" ,"Laboratory_contact_phone" ) call oTestDescFile.WriteRootProp("Laboratory contact fax" ,"Laboratory_contact_fax" ) call oTestDescFile.WriteRootProp("Laboratory contact email" ,"Laboratory_contact_email" ) call oTestDescFile.WriteRootProp("Laboratory test ref. number" ,"Laboratory_test_ref__number" ) call oTestDescFile.WriteRootProp("Customer name" ,"Customer_name" ) call oTestDescFile.WriteRootProp("Customer test ref. number" ,"Customer_test_ref__number" ) call oTestDescFile.WriteRootProp("Customer project ref. number","Customer_project_ref__number") call oTestDescFile.WriteRootProp("Customer order number" ,"Customer_order_number" ) call oTestDescFile.WriteRootProp("Customer cost unit" ,"Customer_cost_unit" ) call oTestDescFile.WriteRootProp("Customer test engineer name" ,"Customer_test_engineer_name" ) call oTestDescFile.WriteRootProp("Customer test engineer phone","Customer_test_engineer_phone") call oTestDescFile.WriteRootProp("Customer test engineer fax" ,"Customer_test_engineer_fax" ) call oTestDescFile.WriteRootProp("Customer test engineer email","Customer_test_engineer_email") call oTestDescFile.WriteRootProp("Title" ,"Title" ) call oTestDescFile.WriteValue( "Medium No./number of media" ,"1/1" ) call oTestDescFile.WriteRootProp("Timestamp" ,"Timestamp" ) call oTestDescFile.WriteRootProp("Type of the test" ,"Type_of_the_test" ) oTestDescFile.PropOptional = TRUE call oTestDescFile.WriteRootProp("Subtype of the test" ,"Subtype_of_the_test" )'RED A call oTestDescFile.WriteRootProp("Regulation" ,"Regulation" )'RED A oTestDescFile.PropOptional = False call oTestDescFile.WriteRootProp("Reference temperature" ,"Reference_temperature" ) call oTestDescFile.WriteRootProp("Relative air humidity" ,"Relative_air_humidity" ) call oTestDescFile.WriteRootProp("Date of the test" ,"Date_of_the_test" ) call oTestDescFile.WriteValue( "Number of test objects" ,GroupCount ) if GroupCount>0 then for i = 1 to GroupCount call oTestDescFile.WriteValue( "Name of test object " & i ,GroupName(i) ) call oTestDescFile.WriteGroupProp("Velocity test object " & i ,"Velocity_test_object" , i) call oTestDescFile.WriteGroupProp("Mass test object " & i ,"Mass_test_object" , i) call oTestDescFile.WriteGroupProp("Driver position object " & i ,"Driver_position_object" , i) call oTestDescFile.WriteGroupProp("Impact side test object " & i ,"Impact_side_test_object" , i) call oTestDescFile.WriteGroupProp("Type of test object " & i ,"Type_of_test_object" , i) call oTestDescFile.WriteGroupProp("Class of test object " & i ,"Class_of_test_object" , i) call oTestDescFile.WriteGroupProp("Code of test object " & i ,"Code_of_test_object" , i) call oTestDescFile.WriteGroupProp("Ref. number of test object "& i ,"Ref__number_of_test_object" , i) next end if call oTestDescFile.close() end if set oTestDescFile = NOTHING Call LoopInc(dLoopFrac) 'Create channel folder call FolderCreate(sChnFolder) 'Write Channel Information File and Test Channel Files lChnCount = 0 ReDim sChnName(lChnCount) if GlobUsedChn > 0 then for i = 1 to GlobUsedChn 'Skip implicit linear, text and time channels if (ChnPropGet(i,"representation")<>"implicit_linear") and (ChnPropGet(i,"displaytype")="Numeric") then 'Count and store channel name lChnCount = lChnCount+1 ReDim Preserve sChnName(lChnCount) sChnName(lChnCount) = ChnName(i) 'Use channel to write a Test Channel File sChnFilePath = sChnFolder & "\" & sTestNumber & "." & right("000"&lChnCount,3) set oChnFile = new clsMMEDataFile set oChnFile.Errors = oErrors call oChnFile.create( sChnFilePath, eWriteMode) If oChnFile.IsOpen then oChnFile.PropOptional = FALSE call oChnFile.WriteValue( "Test object number" ,ChnGroup(i) ) oChnFile.PropOptional = TRUE 'RED A: data staus should be used instead of errors occured call oChnFile.WriteChnProp("Errors occurred" ,"Errors_occurred" , i) oChnFile.PropOptional = FALSE call oChnFile.WriteChnProp("Name of the channel" ,"Name_of_the_channel" , i) call oChnFile.WriteChnProp("Laboratory channel code" ,"Laboratory_channel_code" , i) call oChnFile.WriteChnProp("Customer channel code" ,"Customer_channel_code" , i) call oChnFile.WriteValue( "Channel code" ,ChnName(i) ) oChnFile.PropOptional = TRUE call oChnFile.WriteChnProp("Location" ,"Location" , i) call oChnFile.WriteChnProp("Direction" ,"Direction" , i) call oChnFile.WriteChnProp("Dimension" ,"Dimension" , i) call oChnFile.WriteChnProp("Channel frequency class" ,"Channel_frequency_class" , i) oChnFile.PropOptional = FALSE call oChnFile.WriteValue( "Unit" ,ChnDim(i) ) call oChnFile.WriteChnProp("Reference system" ,"Reference_system" , i) call oChnFile.WriteChnProp("Transducer type" ,"Transducer_type" , i) call oChnFile.WriteChnProp("Pre-filter type" ,"Pre_filter_type" , i) call oChnFile.WriteChnProp("Cut off frequency" ,"Cut_off_frequency" , i) call oChnFile.WriteChnProp("Channel amplitude class" ,"Channel_amplitude_class" , i) call oChnFile.WriteChnProp("Sampling interval" ,"Sampling_interval" , i) call oChnFile.WriteChnProp("Bit resolution" ,"Bit_resolution" , i) call oChnFile.WriteChnProp("Time of first sample" ,"Time_of_first_sample" , i) call oChnFile.WriteValue( "Number of samples" ,ChnLength(i) ) oChnFile.PropOptional = TRUE call oChnFile.WriteChnProp("First global maximum value","First_global_maximum_value" , i) call oChnFile.WriteChnProp("Time of maximum value" ,"Time_of_maximum_value" , i) call oChnFile.WriteChnProp("First global minimum value","First_global_minimum_value" , i) call oChnFile.WriteChnProp("Time of minimum value" ,"Time_of_minimum_value" , i) call oChnFile.WriteChnProp("Start offset interval" ,"Start_offset_interval" , i) call oChnFile.WriteChnProp("End offset interval" ,"End_offset_interval" , i) call oChnFile.WriteChnProp("Reference channel" ,"Reference_channel" , i)'RED A call oChnFile.WriteChnProp("Reference channel name" ,"Reference_channel_name" , i)'RED A call oChnFile.WriteChnProp("Data source" ,"Data_source" , i)'RED A call oChnFile.WriteChnProp("Data status" ,"Data_status" , i)'RED A oChnFile.PropOptional = FALSE Call oChnFile.WriteChnData(i) call oChnFile.close() end if set oChnFile = NOTHING end if Call LoopInc((dLoopFrac*i)+1) next end if 'Write Channel Information File sChnInfoFilePath = sChnFolder & "\" & sTestNumber & ".chn" set oChnInfoFile = new clsMMEDataFile set oChnInfoFile.Errors = oErrors call oChnInfoFile.create( sChnInfoFilePath, eWriteMode) if oChnInfoFile.IsOpen then call oChnInfoFile.WriteRootProp( "Instrumentation standard" ,"Instrumentation_standard") call oChnInfoFile.WriteValue( "Number of channels" ,lChnCount ) if lChnCount>0 then for i=1 to lChnCount call oChnInfoFile.WriteValue("Name of channel "&right("000"&i,3) ,sChnName(i) ) next end if end if Call LoopInc(100-dLoopFrac) 'Copy errors to DIAdem logfile and deinit loop display call MsgLineDisp(MMETextGet(eMMEMsgStatusLogging,"","")) call oErrors.DIAdemLog(sFilePath) Call LoopInc(100) call MsgLineDisp(MMETextGet(eMMEMsgStatusFinished,sFilePath,"")) 'Give warning message in case of errors if oErrors.Count>0 then call MsgBoxDisp( MMETextGet(eMMEMsgExportErrors,sFilePath,oErrors.Count), "MB_OK", "MsgTypeWarning") end if Call LoopDeInit() set oErrors = NOTHING set oNumLocale = NOTHING end sub '------------------------------------------------------------------------------- sub MMEExportWithDialog call FileNameGet("Any", "FileWrite", DataDrvUser&DataSetName, "MME Export (*.mme),*.mme") if DlgState = "IDOk" then if FilEx(FileDlgDir&FileDlgFile&FileDlgExt) then call MsgBoxDisp("Overwrite existing files?","MB_OkCancel") if MsgState <> "IDOk" then exit sub end if end if DataDrvUser = FileDlgDir call MMEExport(FileDlgDir&FileDlgFile&FileDlgExt) end if end sub '------------------------------------------------------------------------------- class clsMMEErrors Dim mlCount Dim mlNumber() Dim msDescription() Dim msSource() Dim mbDIAdemLogFileExtent(4) Dim mbResetLogFileExtent '---------------------------- Private Sub Class_Initialize dim i dim lProof 'disable DIAdem error logging and init member varaibles lProof = 0 for i=1 to 4 mbDIAdemLogFileExtent(i)=LOGFILEEXTENT(i) LOGFILEEXTENT(i)=0 lProof = lProof + mbDIAdemLogFileExtent(i) next mbResetLogFileExtent = CBool(lProof<>0) mlCount = 0 Redim mlNumber(0) Redim msDescription(0) Redim msSource(0) end sub '---------------------------- Private Sub Class_Terminate dim i 'reset DIAdem error logging if mbResetLogFileExtent then for i=1 to 4 LOGFILEEXTENT(i)=mbDIAdemLogFileExtent(i) next end if end sub '---------------------------- Public property get Count Count = mlCount end property '---------------------------- Public property get Number(i) Number = mlNumber(i) end property '---------------------------- Public property get Description(i) Description = msDescription(i) end property '---------------------------- Public property get Source(i) Source = msSource(i) end property '---------------------------- Public sub Add( lNumber, sDescription, sSource) mlCount = mlCount + 1 Redim Preserve mlNumber(mlCount) Redim Preserve msDescription(mlCount) Redim Preserve msSource(mlCount) mlNumber(mlCount) = lNumber msDescription(mlCount) = sDescription msSource(mlCount) = sSource end sub '---------------------------- Public sub DIAdemLog(sLogForFile) call LogFileWrite(" ") call LogFileWrite( MMETextGet(eMMEMsgLogBegin,sLogForFile,CurrDateTime)) Dim i i= 1 while i<=UBound(mlNumber) call LogFileWrite( MMETextGet(eMMEMsgLogCaption,right("000"&i,3),"")) call LogFileWrite( msDescription(i)) call LogFileWrite( msSource(i)) i = i+1 wend call LogFileWrite( MMETextGet(eMMEMsgLogEnd,sLogForFile,CurrDateTime)) end sub end class '------------------------------------------------------------------------------- class clsMMEDataFile dim msDataFilePath dim mlFileHandle dim mbFileOpen dim moErrors dim mbPropOptional '---------------------------- Private Sub Class_Initialize mbPropOptional = FALSE mlFileHandle = -1 msDataFilePath = "" mbFileOpen = FALSE set moErrors = new clsMMEErrors end sub '---------------------------- Private Sub Class_Terminate dim lError 'Close data file if mbFileOpen then _ lError = TextFileClose(mlFileHandle) end sub '---------------------------- Private function mFormatLine( sPropName, vPropValue) mFormatLine = left(sPropName&" ",28) & ":" & CStr(vPropValue) end function '---------------------------- Public property get Errors set Errors = moErrors end property Public property set Errors(oErrors) set moErrors = NOTHING set moErrors = oErrors end property '---------------------------- Public property get IsOpen IsOpen = mbFileOpen end property '---------------------------- Public property get FilePath FilePath = msDataFilePath end property '---------------------------- Public property get PropOptional PropOptional = mbPropOptional end property '---------------------------- Public property let PropOptional(bPropOptional) mbPropOptional = bPropOptional end property '---------------------------- Public sub Create( sDataFilePath, enumMode) if enumMode <> eMMEOverwrite then if CBool(FilEx(sDataFilePath)) then 'exit create, because file exists call moErrors.Add( clMMEStdError, _ MMETextGet(eMMEMsgFileExists,sDataFilePath,""),"File create") exit sub end if end if mlFileHandle = TextFileOpen(sDataFilePath,TfCreate OR tfWrite OR tfANSI) if mlFileHandle <> 0 then msDataFilePath = sDataFilePath mbFileOpen = TRUE else call moErrors.Add(TextFileError(mlFileHandle),TextFileErrorTxt(mlFileHandle),"File open") mbFileOpen = FALSE end if end sub '---------------------------- Public sub Close() dim lError lError = TextFileClose(mlFileHandle) if lError<>0 then _ call moErrors.Add( lError, "", "File close") mbFileOpen = FALSE end sub '---------------------------- Public sub WriteChnProp( sFilePropName, sChnPropName, vChannel) Dim vPropValue Dim lError On Error Resume Next vPropValue = ChnPropGet(vChannel,sChnPropName) if NOT CBool(Err) then On Error Goto 0 else On Error Goto 0 if mbPropOptional then exit sub vPropValue = csMMENovalue call moErrors.Add( clMMEStdError, _ MMETextGet(eMMEMsgChnPropErr,sChnPropName,vChannel), _ MMETextGet(eMMEMsgPropSource,msDataFilePath,sFilePropName)) end if lError = TextFileWriteLn( mlFileHandle, mFormatLine(sFilePropName,vPropValue)) end sub '---------------------------- Public sub WriteGroupProp( sFilePropName, sGroupPropName, vGroup) Dim vPropValue Dim lError On Error Resume Next vPropValue = GroupPropGet(vGroup,sGroupPropName) if NOT CBool(Err) then On Error Goto 0 else On Error Goto 0 if mbPropOptional then exit sub vPropValue = csMMENovalue call moErrors.Add( clMMEStdError, _ MMETextGet(eMMEMsgGroupPropErr,sGroupPropName,vGroup), _ MMETextGet(eMMEMsgPropSource,msDataFilePath,sFilePropName)) end if lError = TextFileWriteLn( mlFileHandle, mFormatLine(sFilePropName,vPropValue)) end sub '---------------------------- Public sub WriteRootProp( sFilePropName, sRootPropName) Dim vPropValue Dim lError On Error Resume Next vPropValue = RootPropGet(sRootPropName) if NOT CBool(Err) then On Error Goto 0 else On Error Goto 0 if mbPropOptional then exit sub vPropValue = csMMENovalue call moErrors.Add( clMMEStdError, _ MMETextGet(eMMEMsgRootPropErr,sRootPropName,""), _ MMETextGet(eMMEMsgPropSource,msDataFilePath,sFilePropName)) end if lError = TextFileWriteLn( mlFileHandle, mFormatLine(sFilePropName,vPropValue)) end sub '---------------------------- Public sub WriteValue( sFilePropName, vPropValue) Dim lError lError = TextFileWriteLn( mlFileHandle, mFormatLine(sFilePropName,vPropValue)) end sub '---------------------------- Public sub WriteChnData( vChannel) Dim lIndex, lChnLen, lChnNo Dim lError lChnLen = CL(vChannel) lChnNo = CLng(ChnPropGet(vChannel, "number")) if lChnLen > 0 then for lIndex = 1 to lChnLen lError = TextFileWriteLn( mlFileHandle, CStr(ChDx(lIndex, lChnNo))) next end if end sub end class '------------------------------------------------------------------------------- ' Class to set the locale to en-us and set it back when the script finishes ' This is important to make sure that '.' is interpreted as decimal point '------------------------------------------------------------------------------- Class clsNumLocale Dim mOriginalLocale Private Sub Class_Initialize mOriginalLocale = GetLocale call SetLocale("en-us") End Sub Private Sub Class_Terminate call SetLocale(mOriginalLocale) End Sub End Class '------------------------------------------------------------------------------- function MMETextGet( enumMsgText, sPar1, sPar2) if enumMsgText = eMMEMsgFileExists then MMETextGet = "The file """&sPar1&""" already exists." elseif enumMsgText = eMMEMsgChnPropErr then MMETextGet = "Channel property """&sPar1&""" is missing on channel """&sPar2&"""." elseif enumMsgText = eMMEMsgPropSource then MMETextGet = "Writing identifier """&sPar2&""" on file """&sPar1&"""." elseif enumMsgText = eMMEMsgGroupPropErr then MMETextGet = "Group property """&sPar1&""" is missing on group """&sPar2&"""." elseif enumMsgText = eMMEMsgRootPropErr then MMETextGet = "Root property """&sPar1&""" is missing." elseif enumMsgText = eMMEMsgInvalidProp then MMETextGet = "Invalid property value """&sPar1&"""." elseif enumMsgText = eMMEMsgSubFolderErr then MMETextGet = "Subfolder name """&sPar1&""" is not equal to MME file name """&sPar2&"""." elseif enumMsgText = eMMEMsgSubFolderSrc then MMETextGet = "Checking subfolder name." elseif enumMsgText = eMMEMsgLogCaption then MMETextGet = "----- MME Export Warning "&sPar1& " -----" elseif enumMsgText = eMMEMsgLogBegin then MMETextGet = "===== MME Export Log Start for """&sPar1& """ on " &sPar2& " =====" elseif enumMsgText = eMMEMsgLogEnd then MMETextGet = "===== MME Export Log End for """&sPar1& """ on " &sPar2& " =====" elseif enumMsgText = eMMEMsgExportErrors then MMETextGet = "MME export of """&sPar1&""" has finished with "&sPar2&" warnings." &vbCRLF&vbCRLF& _ "Refer to DIAdem log file for more information." elseif enumMsgText = eMMEMsgStatusExporting then MMETextGet = "Exporting MME file """&sPar1& """ ..." elseif enumMsgText = eMMEMsgStatusLogging then MMETextGet = "Writing to DIAdem log file ..." elseif enumMsgText = eMMEMsgStatusFinished then MMETextGet = "MME file """&sPar1& """ has been written." else MMETextGet="" end if end function '------------------------------------------------------------------------------- call MMEExport(DataFileName)