Function DBW_Audit_Manager_Events(CtrlEntId, Event, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10, Param11, Param12, Param13, Param14, Param15) //////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////// // // This program is proprietary and is not to be used by or disclosed to others, nor is it to // be copied without written permission from SRP Computer Solutions, Inc. // // Name : DBW_Audit_Manager_Events // // Description: This function acts as a commuter module for all events related to this window. // // Notes: Commuter Modules are automatically called from the Promoted_Events function // which is called by the application-specific promoted event handler. This makes // it possible to add QuickEvents that need to execute Basic+ logic without having // use the Form Designer to make the association, although this is limited to the // events which are currently promoted. // // If the form needs to call the commuter module directly then the QuickEvent // parameters should be formatted like this: // // '@SELF','@EVENT',['@PARAM1','@PARAMx'] // // Parameters: // CtrlEntId [in] -- The fully qualified name of the control calling the promoted event // Event [in] -- The event being executed. See the Notes section regarding "PRE" events // Param1-15 [in] -- Additional event parameter holders // EventFlow [out] -- Set to 1 or 0 so the calling event knows whether or not to // chain forward. See comments in EVENT_SETUP insert // // History (Date, Initials, Notes) // 07/23/98 dmb Original programmer // 04/06/10 rch Hard-code fonts in SRP EditTable to 8pt size for consistency on all systems. // 11/02/10 rch Hard-code fonts in SRP EditTable to Tahoma for consistency on all systems. // //////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////// $insert APP_INSERTS $insert EVENT_SETUP $insert MSG_EQUATES GoSub Get_MFS_Name * MFSName = "AUDIT_MANAGER_MFS*":@APPID<1> AuditManagerTable = "APP_INFO" ID = Get_Property(@Window:".EDL_FIELD_TRACEABILITY", "TEXT") Declare subroutine V119, Attach_Table, Detach_table, SRP_Set_Prop_Array, SRP_Show_Window, Set_Status, Set_MFS, Define_Database, Create_Table, RTP5, Declare subroutine Retstack, Delete_Table, Define_Database, Send_Message, Send_Event, Set_Property Declare function Verify_Access, PopUp Begin Case Case Control EQ Window // This event is window specific. Begin Case Case Event EQ "CREATE" ; GoSub CREATE Case Event EQ "READ" ; GoSub READ Case Event EQ "WRITE" ; GoSub WRITE End Case Case Control EQ "EDT_AUDIT_TABLES" Begin Case Case Event EQ "OnOptionClick" ; GoSub OnOptionClick.EDT_AUDIT_TABLES Case Event EQ "BeforeUpdate" ; GoSub BeforeUpdate.EDT_AUDIT_TABLES Case Event EQ "AfterUpdate" ; GoSub AfterUpdate.EDT_AUDIT_TABLES Case Event EQ "OnCheckChanged" ; GoSub OnCheckChanged.EDT_AUDIT_TABLES Case Event EQ "BeforeDeleteRecords" ; GoSub BeforeDeleteRecords.EDT_AUDIT_TABLES Case Event EQ "BeforeInsertRecords" ; GoSub BeforeInsertRecords.EDT_AUDIT_TABLES Case Event EQ "PosChanging" ; GoSub PosChanging.EDT_AUDIT_TABLES End Case End Case If Assigned(EventFlow) else EventFlow = EVENT_CONTINUE$ Return EventFlow CREATE: *--------------------------------------------------------------------------------------------------------------------------------------------- * This is needed to lock down the three important columns and leave the ability to use the SELPOS properties *--------------------------------------------------------------------------------------------------------------------------------------------- Color = "3D Face L=90" PropArray = @Window:".OLE_TAB" PropArray<-1> = "OLE.TabCount" :@VM: 0 PropArray<-1> = "OLE.Height" :@VM: "-8" PropArray<-1> = "OLE.AllowXPTheme" :@VM: Yes$ SRP_Set_Prop_Array(PropArray) PropArray = @Window:".EDT_AUDIT_TABLES" PropArray<-1> = "OLE.WorkspaceBkColor" :@VM: "Window" PropArray<-1> = "OLE.BorderType" :@VM: "XP" PropArray<-1> = "OLE.Dimension<1>" :@VM: 7 ;* number of columns PropArray<-1> = "OLE.Dimension<2>" :@VM: 20 ;* number of rows PropArray<-1> = "OLE.HeaderColumn[1]<2>" :@VM: 0 ;* Visable (Column Numbers?) PropArray<-1> = "OLE.HeaderFont[All;All]" :@VM: 'Tahoma':@SVM:8 ;* Hardcode to 8pt size PropArray<-1> = "OLE.TitleList<1,1>" :@VM: "Table Name" ;* Table Name Column 1 PropArray<-1> = "OLE.TitleList<1,2>" :@VM: "Modified by Pos" PropArray<-1> = "OLE.TitleList<1,3>" :@VM: "Write" ;* Write Flag Column 2 PropArray<-1> = "OLE.TitleList<1,4>" :@VM: "Delete" ;* Delete Flag Column 3 PropArray<-1> = "OLE.TitleList<1,5>" :@VM: "Read" ;* Read Flag Column 4 PropArray<-1> = "OLE.TitleList<1,6>" :@VM: "Tracker" PropArray<-1> = "OLE.TitleList<1,7>" :@VM: "Status" ;* Temporary Column identifying whether the table is attached PropArray<-1> = "OLE.CellType[1; All]" :@VM: "Option" PropArray<-1> = "OLE.CellType[2; All]" :@VM: "Option" PropArray<-1> = "OLE.CellType[3; All]" :@VM: "CHB" PropArray<-1> = "OLE.CellType[4; All]" :@VM: "CHB" PropArray<-1> = "OLE.CellType[5; All]" :@VM: "CHB" PropArray<-1> = "OLE.CellType[6; All]" :@VM: "CHB" PropArray<-1> = "OLE.QuickTabOut" :@VM: 1 PropArray<-1> = "OLE.DataColumn[1]<1>" :@VM: 140 PropArray<-1> = "OLE.DataColumn[1]<2>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[1]<3>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[1]<4>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[2]<1>" :@VM: 90 PropArray<-1> = "OLE.DataColumn[2]<2>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[2]<3>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[3]<1>" :@VM: 40 PropArray<-1> = "OLE.DataColumn[3]<2>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[3]<3>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[4]<1>" :@VM: 40 PropArray<-1> = "OLE.DataColumn[4]<2>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[4]<3>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[5]<1>" :@VM: 40 PropArray<-1> = "OLE.DataColumn[5]<2>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[5]<3>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[6]<1>" :@VM: 50 PropArray<-1> = "OLE.DataColumn[6]<2>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[6]<3>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[7]<1>" :@VM: 90 PropArray<-1> = "OLE.DataColumn[7]<2>" :@VM: 1 PropArray<-1> = "OLE.DataColumn[7]<3>" :@VM: 1 PropArray<-1> = "OLE.CellAlignment[3;All]<2>" :@VM: "C" PropArray<-1> = "OLE.CellAlignment[4;All]<2>" :@VM: "C" PropArray<-1> = "OLE.CellAlignment[5;All]<2>" :@VM: "C" PropArray<-1> = "OLE.CellAlignment[6;All]<2>" :@VM: "C" PropArray<-1> = "OLE.CellColors[3;All]<2>" :@VM: Color PropArray<-1> = "OLE.CellColors[4;All]<2>" :@VM: Color PropArray<-1> = "OLE.CellColors[5;All]<2>" :@VM: Color PropArray<-1> = "OLE.CellColors[6;All]<2>" :@VM: Color PropArray<-1> = "OLE.CellFont[All;All]" :@VM: 'Tahoma':@SVM:8 PropArray<-1> = "OLE.MinCellSize" :@VM: 16 SRP_Set_Prop_Array(PropArray) Qualifier = "" Qualifier<1> = Yes$ Qualifier<4> = Yes$ Send_Message(@Window:".EDT_AUDIT_TABLES", "QUALIFY_EVENT", "ALL_OLES", Qualifier) Send_Event(@Window, "READ") SRP_Show_Window(@Window, "", "L", "T", Yes$, "", No$, No$) return PosChanging.EDT_AUDIT_TABLES: PropArray = CtrlEntId ColPos = Field(Param2, ";", 1, 1) RowPos = Field(Param2, ";", 2, 1) ByPassFlag = No$ rv = Get_Property(CtrlEntId, "OLE.CellText[1;":RowPos:"]") tVal = Get_Property(CtrlEntId, "OLE.CellText[7;":RowPos:"]") Begin Case Case ColPos = 1 If rv EQ "" Then PropArray<-1> = "OLE.CellType[1;":Rowpos:"]" :@VM: "OPT" PropArray<-1> = "OLE.CellType[2;":Rowpos:"]" :@VM: "OPT" PropArray<-1> = "OLE.CellType[7;":RowPos:"]" :@VM: "TXT" PropArray<-1> = "OLE.CellCheck[3;":RowPos:"]" :@VM: "" PropArray<-1> = "OLE.CellCheck[4;":RowPos:"]" :@VM: "" PropArray<-1> = "OLE.CellCheck[5;":RowPos:"]" :@VM: "" PropArray<-1> = "OLE.CellCheck[6;":Rowpos:"]" :@VM: "" PropArray<-1> = "OLE.CellText[7;":RowPos:"]" :@VM: "" PropArray<-1> = "OLE.CellProtection[1;":RowPos:"]" :@VM: "None" PropArray<-1> = "OLE.CellProtection[2;":RowPos:"]" :@VM: "None" PropArray<-1> = "OLE.CellProtection[7;":RowPos:"]" :@VM: "None" End Case Otherwise$ If rv = "" Or tVal = "Not Attached" Then PropArray<-1> = "OLE.CellType[2;":Rowpos:"]" :@VM: "TXT" PropArray<-1> = "OLE.CellProtection[2;":RowPos:"]" :@VM: "SEL" PropArray<-1> = "OLE.CellProtection[7;":RowPos:"]" :@VM: "FULL" End Else PropArray<-1> = "OLE.CellType[2;":Rowpos:"]" :@VM: "OPT" PropArray<-1> = "OLE.CellProtection[2;":RowPos:"]" :@VM: "None" Begin Case Case tVal = "Activate" PropArray<-1> = "OLE.CellType[7;":RowPos:"]" :@VM: "TXT" PropArray<-1> = "OLE.CellProtection[7;":RowPos:"]" :@VM: "SEL" Case Otherwise$ PropArray<-1> = "OLE.CellType[1;":Rowpos:"]" :@VM: "TXT" PropArray<-1> = "OLE.CellType[7;":RowPos:"]" :@VM: "OPT" PropArray<-1> = "OLE.CellProtection[1;":RowPos:"]" :@VM: "SEL" PropArray<-1> = "OLE.CellProtection[7;":RowPos:"]" :@VM: "None" End Case End End Case SRP_Set_Prop_Array(PropArray) return READ: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- rVal = Get_Property(@Window:".EDT_AUDIT_TBACK", "ARRAY") MxVal = Count(rVal<1>, @VM) + (rVal<1> NE "") Set_Property(@Window:".EDT_AUDIT_TABLES", "OLE.Array", rVal) CtrlEntId = @Window:".EDT_AUDIT_TABLES" Gosub Select_Table List = nTables fMore = Yes$ Work = "" DisplayList = List NumItems = Count(List, @FM) + (List NE "") For i = 1 to NumItems Work := DisplayList:@FM:List:@RM Next i V119("S", "", "A", "L", Work, "") For i = 1 to NumItems Line = Field(Work, @RM, i) DisplayList = Line<1> List = Line<2> Next i Convert @FM to @VM in List Set_Property(@Window:".EDT_STOREINFO", "ARRAY", List) For X = 1 to MxVal If rVal<1,X> NE "" Then RowPos = X ColPos = 2 TableName = rVal<1,X> Gosub Update_Row End Next X Set_Property("SYSTEM", "FOCUS", @Window:".EDT_AUDIT_TABLES") Set_Property(@Window, "SAVEWARN", No$) SRP_Show_Window(@Window, "", "L", "T", Yes$, "", No$, No$) Set_Property(@Window:".EDT_AUDIT_TABLES", "NEXT", @Window:".EDT_AUDIT_TABLES") return WRITE: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- If ID NE "" Then Open AuditManagerTable to hAIT Then cVal = Get_Property(@Window:".EDT_AUDIT_TABLES", "OLE.Array") MxVals = Count(cVal<1>, @VM) + (cVal<1> NE "") rVal = cVal nPos = 0 For nV = 1 to MxVals TableName = cVal<1,nV> cPos = "7;":nV nPos += 1 Begin Case Case trim(cVal<7,nV>) = "" For dC = 1 to 7 rVal = Delete(rVal, dC, nPos, 0) Next dC nPos -= 1 Case cVal<7,nV> = "Activate" rVal<7,nPos> = "Active" Set_Property(@Window:".EDT_AUDIT_TABLES", "OLE.CellText[":cPos:"]", "Active") Gosub Add_MFS Case cVal<7,nV> = "Remove" For dC = 1 to 7 rVal = Delete(rVal, dC, nPos, 0) Next dC nPos -= 1 Set_Property(@Window:".EDT_AUDIT_TABLES", "OLE.CellText[":cPos:"]", "Removed") Gosub Remove_MFS Gosub Delete_Audit_Table Case cVal<7,nV> = "Removed" For dC = 1 to 7 rVal = Delete(rVal, dC, nPos, 0) Next dC nPos -= 1 Case cVal<7,nV> = "Suspend" rVal<7,nPos> = "Suspended" Set_Property(@Window:".EDT_AUDIT_TABLES", "OLE.CellText[":cPos:"]", "Suspended") Gosub Remove_MFS End Case Param1 = cPos Gosub PosChanging.EDT_AUDIT_TABLES Next MxVal Write rVal to hAIT, ID Else RecId = ID ErrorMsg = "WRITE" Gosub MsgAlert End Gosub Select_Table End Else TableName = "APP INFO" ErrorMsg = "OPEN" Gosub MsgAlert End End return BeforeUpdate.EDT_AUDIT_TABLES: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- ColPos = Field(Param1, ";", 1) RowPos = Field(Param1, ";", 2) Begin Case Case ColPos = 1 AvailTables = Get_Property(@Window:".EDT_STOREINFO", "ARRAY") CurrentTables = Get_Property(@Window:".EDT_AUDIT_TABLES", "OLE.Array") Convert @Lower_Case to @Upper_Case In Param2 Locate Param2 In CurrentTables<1> Using @VM Setting nPos Then ErrorMsg = "UPDATE2" TableName = Param2 Gosub MsgAlert Set_Property(CtrlEntId, "OLE.Cancel", Yes$) End Else Locate Param2 In AvailTables Using @VM Setting Pos Then TableName = Param2 Gosub Update_Row End Else ErrorMsg = "UPDATE" TableName = Param2 Gosub MsgAlert Set_Property(CtrlEntId, "OLE.Cancel", Yes$) End End Case ColPos = 2 If Num(Param2) Else Gosub Get_Dict_Items Convert @Lower_Case to @Upper_Case in Param2 Locate Param2 in Original_list Using @FM Setting dPos Else M_st = "" M_st<1> = Param2:" is not a Dictiony Item in the ":CurTable:" table." M_st<4> = "*" M_st<8> = "L" M_st<9> = Msg_light_grey$ M_st<11> = 350 M_st<12> = "Record Search" rv = Msg("", M_st) Set_Property(CtrlEntId, "OLE.Cancel", Yes$) End End Case ColPos = 7 End Case return AfterUpdate.EDT_AUDIT_TABLES: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- ColPos = Field(Param1, ";", 1) RowPos = Field(Param1, ";", 2) Begin Case Case ColPos = 1 Convert @Lower_Case to @Upper_Case In Param2 Set_Property(@Window:".EDT_AUDIT_TABLES", "OLE.CellText[":Param2:"]", Param2) Case ColPos = 2 If Num(Param2) Else Gosub Get_Dict_Items Convert @Lower_Case to @Upper_Case in Param2 Locate Param2 in Original_list Using @FM Setting dPos Then Text = Param2 Convert "," to @FM in Text Convert ";" to @FM in Text Gosub First_Caps Convert @FM to @VM in Text Cols = Text Gosub Convert_Cols End End End Case Set_Property(@Window, "SAVEWARN", Yes$) return OnOptionClick.EDT_AUDIT_TABLES: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- ColPos = Field(Param1, ";", 1) RowPos = Field(Param1, ";", 2) Begin Case Case ColPos = 1 PopupVals = Get_Property(@Window:".EDT_STOREINFO", "ARRAY") If PopupVals then PopupStats = "" PopupStats<1> = - 2 PopupStats<2> = - 2 PopupStats<3> = -1 PopupStats<4> = -1 PopupStats<5> = 16777215 PopupStats<6> = "MS Sans Serif":@SVM:-11:@SVM:400:@SVM:0:@SVM:0:@SVM:6:@SVM:0:@SVM:33:@SVM:0:@SVM:0:@SVM:0:@SVM:0:@SVM:11:@SVM:2:@SVM:0:@SVM:12 PopupStats<8> = PopupVals PopupStats<9> = @SVM:30:@SVM:"L":@SVM:"L":@SVM:@SVM:"Table Names" PopupStats<10> = "L" PopupStats<11> = 1 PopupStats<12> = "Audit Manager" PopupStats<13> = 1 PopupStats<14> = "F" PopupStats<15> = 0 PopupStats<16> = 0 PopupStats<17> = 0 PopupStats<18> = 1 PopupStats<19> = 1 PopupStats<20> = 1 PopupStats<21> = 1 PopupStats<22> = 1 TableName = PopUp(@Window, PopupStats) If TableName then CurrentTables = Get_Property(@Window:".EDT_AUDIT_TABLES", "OLE.Array") Locate TableName In CurrentTables<1> Using @VM Setting nPos Then ErrorMsg = "UPDATE2" Gosub MsgAlert Set_Property(CtrlEntId, "OLE.CellText[":Param1:"]", "") End Else Gosub Update_Row Set_Property(@Window, "SAVEWARN", Yes$) End End End Else T_name = Get_Property(@Window, "@TABLE_NAME") M_st = "" M_st<1> = "There are no Tables attached to application ":@AppId<1> M_st<4> = "*" M_st<8> = "L" M_st<9> = Msg_light_grey$ M_st<11> = 350 M_st<12> = "Audit Manager" rv = Msg("", M_st) End Case ColPos = 2 Gosub Get_Dict_Items If Fields then P_st = "" P_st<1> = -2 P_st<2> = -2 P_st<3> = -1 P_st<4> = -1 P_st<5> = 16777215 P_st<6> = "MS Sans Serif":@SVM:-11:@SVM:400:@SVM:0:@SVM:0:@SVM:6:@SVM:0:@SVM:33:@SVM:0:@SVM:0:@SVM:0:@SVM:0:@SVM:11:@SVM:2:@SVM:0:@SVM:12 P_st<8> = Display_list P_st<9> = @SVM:30:@SVM:"L":@SVM:"L":@SVM:@SVM:"Column Names" P_st<10> = "L" P_st<11> = 1 P_st<12> = "Available Columns in the ":CurTable:" Table" P_st<13> = 1 P_st<14> = "F" P_st<15> = 1 P_st<16> = 0 P_st<17> = 0 P_st<18> = 1 P_st<19> = 1 P_st<20> = 1 P_st<21> = 1 P_st<28> = CurSelInfo Cols = PopUp(@Window, P_st) Gosub Convert_Cols end else M_st = "" M_st<1> = "There are no columns defined for ":CurTable:"." M_st<4> = "*" M_st<8> = "L" M_st<9> = Msg_light_grey$ M_st<11> = 350 M_st<12> = "Record Search" rv = Msg("", M_st) end Case ColPos = 7 rv = Get_Property(CtrlEntId, "OLE.CellText[":Param1:"]") Begin Case Case rv = "" DiplayList = "" Case rv = "Active" DisplayList = "Suspend":@VM:"Remove" Case rv = "Suspend" DisplayList = "Active":@VM:"Remove" Case rv = "Suspended" DisplayList = "Activate":@VM:"Remove" Case rv = "Remove" DisplayList = "Active":@VM:"Suspend" Case rv = "Removed" DisplayList = "Activate" End Case If DisplayList NE "" Then PopupStats = "" PopupStats<1> = - 2 PopupStats<2> = - 2 PopupStats<3> = -1 PopupStats<4> = -1 PopupStats<5> = 16777215 PopupStats<6> = "MS Sans Serif":@SVM:-11:@SVM:400:@SVM:0:@SVM:0:@SVM:6:@SVM:0:@SVM:33:@SVM:0:@SVM:0:@SVM:0:@SVM:0:@SVM:11:@SVM:2:@SVM:0:@SVM:12 PopupStats<8> = DisplayList PopupStats<9> = @SVM:10:@SVM:"L":@SVM:"L":@SVM:@SVM:"Status" PopupStats<10> = "L" PopupStats<11> = 1 PopupStats<12> = "Audit Manager" PopupStats<13> = 1 PopupStats<14> = "F" PopupStats<15> = 0 PopupStats<16> = 0 PopupStats<17> = 0 PopupStats<18> = 1 PopupStats<19> = 1 PopupStats<20> = 1 PopupStats<21> = 1 PopupStats<22> = 0 StatusName = PopUp(@Window, PopupStats) If StatusName Then OKtoContinue = Yes$ If StatusName = "Remove" Then TableName = Get_Property(CtrlEntId, "OLE.CellText[1;":RowPos:"]") * AuditTableName = "AUDIT_":TableName ErrorMsg = "WARNING" Gosub MsgAlert If retVal NE Yes$ Then OKtoContinue = No$ End If OKtoContinue = Yes$ Then Set_Property(CtrlEntId, "OLE.CellText[":Param1:"]", StatusName) Set_Property(@Window, "SAVEWARN", Yes$) End End End End Case return OnCheckChanged.EDT_AUDIT_TABLES: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- RowPos = Field(Param1, ";", 2, 1) rv = Get_Property(CtrlEntId, "OLE.CellText[1;":RowPos:"]") If rv EQ "" Then Set_Property(CtrlEntId, "OLE.CellCheck[":Param1:"]", "") Set_Property(@Window, "SAVEWARN", Yes$) return BeforeDeleteRecords.EDT_AUDIT_TABLES: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- rv = Get_Property(CtrlEntId, "OLE.CellText[7;":Param1:"]") Begin Case Case rv = "Activate" Set_Property(CtrlEntId, "OLE.Cancel", No$) Set_Property(@Window, "SAVEWARN", Yes$) Case rv = "" Set_Property(CtrlEntId, "OLE.Cancel", No$) Set_Property(@Window, "SAVEWARN", Yes$) Case Otherwise$ Set_Property(CtrlEntId, "OLE.Cancel", Yes$) End Case return BeforeInsertRecords.EDT_AUDIT_TABLES: *------------------------------------------------------------------------------------------------------------------------------------- * User will not be permitted to insert rows *------------------------------------------------------------------------------------------------------------------------------------- Set_Property(CtrlEntId, "OLE.Cancel", Yes$) return GOTFOCUS.EDT_MFS_INFO: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- FullWrite = Verify_Access(Window) If FullWrite then SelPos = Get_Property(CtrlEntId, "SELPOS") Col = SelPos<1> Row = SelPos<2> If (Col EQ 1) or (Col EQ 2) or (Col EQ 3) then Set_Property(Get_Property(@Window, "MDIFRAME"):".PUB_TB_OPTIONS", "ENABLED", Yes$) end else Set_Property(Get_Property(@Window, "MDIFRAME"):".PUB_TB_OPTIONS", "ENABLED", No$) end end return *---------------------------------- * Internal Processes *---------------------------------- Select_Table: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- Files = "" GoSub Get_MFS_Name * MFSName = "AUDIT_MANAGER_MFS*":@APPID<1> /* Determine which volumes are attached with this application. */ Volumes = @Volumes rVal = Get_Property(@Window:".EDT_AUDIT_TABLES", "OLE.Array") CurTables = rVal<1> CurPosData = rVal<2> TrueVolumes = "" NumVolumes = Count(Volumes, @FM) + (Volumes NE "") For VolLoop = 1 to NumVolumes /* We need to skip over the system volumes (Memory_Resident, Syscolumns, Revboot, and Repository) */ VolPart1 = Field(Volumes, "*", 1, 1) VolPart2 = Field(Volumes, "*", 2, 1) If VolPart1 EQ "RTP57" then If VolPart2 NE "MEMORY_RESIDENT" AND VolPart2 NE "SYSCOLUMNS" AND VolPart2 NE "REVBOOT" AND VolPart2 NE "REPOSITORY" then TrueVolumes<-1> = VolPart2 end end Next VolLoop /* Pull in all tables */ Tables = @Tables(0) UpdatedTables = "" NumTruVols = Count(TrueVolumes, @FM) + (TrueVolumes NE "") AppName = @APPID<1> vAppNames = @APPID For VolLoop = 1 to NumTruVols Attach_table(TrueVolumes, "REVMEDIA", "", "") Open "REVMEDIA" to hRT then Number_tables = Count(Tables, @FM) + (Tables NE "") For Loop = 1 to Number_tables Table = Tables If (Table[1, 1] NE "!") AND (Table[1, 4] NE "DICT") then If (@APPID EQ "SYSPROG") OR (Table[1, 3] NE "SYS") then Begin Case Case Table EQ "ACCESSIBLE_COLUMNS" Case Table EQ AuditManagerTable Case Otherwise$ RevID = Table:"*":AppName ReadO RevRec from hRT, RevID then MFSLine = RevRec<2> Locate MFSName in MFSLine using @VM setting MFSPos then Files := Table:@RM End Else UpdatedTables<-1> = Table End End Else vAppNames<1> = "GLOBAL" FoundTable = No$ MaxApps = Count(vAppNames, @FM) + (vAppNames NE "") For X = 1 to MaxApps RevID = Table:"*":vAppNames ReadO RevRec from hRT, RevID then MFSLine = RevRec<2> Locate MFSName in MFSLine using @VM setting MFSPos then FoundTable = Yes$ Files := Table:@RM End Else FoundTable = Yes$ UpdatedTables<-1> = Table End End Until FoundTable EQ Yes$ Next X If FoundTable EQ No$ Then UpdatedTables<-1> = Table End End Case End End Next Loop Tables = UpdatedTables UpdatedTables = "" Detach_table("REVMEDIA") End else ErrorMsg = "OPEN" TableName = "REVMEDIA" Gosub MsgAlert End Next VolLoop V119("S", "", "A", "L", Files, Flag) Convert @RM to @VM in Files Files[-1, 1] = "" Set_Property(@Window:".EDT_MFS_TABLES", "ARRAY", Files) MaxTables = Count(Files<1>, @VM) + (Files<1> NE "") For X = 1 to MaxTables Locate Files<1,X> in CurTables Using @VM Setting TablePos Else Tables<-1> = Files<1,X> End Locate "AUDIT_":Files<1,X> in Tables Using @FM Setting fPos Then Tables = Delete(Tables, fPos, 0, 0) End Next X nTables = "" MaxTables = Count(Tables, @FM) + (Tables NE "") For X = 1 To MaxTables Locate Tables in CurTables Using @VM Setting TablePos Else nTables<-1> = Tables End Next X return First_Caps: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- FM_Count = Count(Text, @FM) + (Text NE "") For FM = 1 to FM_Count VM_Count = Count(Text, @VM) + (Text NE "") For VM = 1 to VM_Count Temp = Text Convert "_" to " " in Temp Convert @Upper_case to @Lower_case in Temp Len_temp = Len(Temp) For Pos = 1 to Len_temp Cur_char = Temp[Pos, 1] If (Pos EQ 1) OR (Temp[(Pos - 1), 1] EQ " ") then Convert @Lower_case to @Upper_case in Cur_char end Temp[Pos, 1] = Cur_char Next Pos Text = Temp Next VM Next FM return Update_Row: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- If TableName then Set_Property(@Window:".EDT_AUDIT_TABLES", "OLE.CellText[1;":RowPos:"]", TableName) mVAl = Get_Property(@Window:".EDT_MFS_TABLES", "ARRAY") AuditTable = "AUDIT_":TableName v.AuditTable = TableExists(AuditTable) v.TableName = TableExists(TableName) ByPassCheck = No$ PropArray = CtrlEntId If v.TableName Then If v.AuditTable Then Locate TableName in mVal<1> Using @VM Setting Pos Then PropArray<-1> = "OLE.CellType[1;":Rowpos:"]" :@VM: "TXT" PropArray<-1> = "OLE.CellType[7;":RowPos:"]" :@VM: "OPT" PropArray<-1> = "OLE.CellText[7;":RowPos:"]" :@VM: "Active" PropArray<-1> = "OLE.CellProtection[1;":RowPos:"]" :@VM: "SEL" tVal = Get_Property(@Window:".EDT_AUDIT_TABLES", "OLE.CellText[7;":RowPos:"]") If tVal= "" Else ByPassCheck = Yes$ End Else If Event = "READ" Then Begin Case Case rVal<7, RowPos> = "" Status = "Activate" Button = "TXT" Case Otherwise$ Status = "Suspended" Button = "OPT" End Case End Else Status = "Active" Button = "TXT" End PropArray<-1> = "OLE.CellType[1;":Rowpos:"]" :@VM: "OPT" PropArray<-1> = "OLE.CellType[7;":RowPos:"]" :@VM: Button PropArray<-1> = "OLE.CellText[7;":RowPos:"]" :@VM: Status PropArray<-1> = "OLE.CellProtection[1;":RowPos:"]" :@VM: "None" End End Else PropArray = CtrlEntId PropArray<-1> = "OLE.CellType[1;":Rowpos:"]" :@VM: "OPT" PropArray<-1> = "OLE.CellType[7;":RowPos:"]" :@VM: "TXT" PropArray<-1> = "OLE.CellText[7;":RowPos:"]" :@VM: "Activate" PropArray<-1> = "OLE.CellProtection[1;":RowPos:"]" :@VM: "None" End End Else PropArray = CtrlEntId PropArray<-1> = "OLE.CellType[1;":Rowpos:"]" :@VM: "OPT" PropArray<-1> = "OLE.CellType[7;":RowPos:"]" :@VM: "TXT" PropArray<-1> = "OLE.CellText[7;":RowPos:"]" :@VM: "Not Attached" PropArray<-1> = "OLE.CellProtection[1;":RowPos:"]" :@VM: "None" End If ByPassCheck = No$ Then PropArray<-1> = "OLE.CellCheck[3;":RowPos:"]" :@VM: 1 PropArray<-1> = "OLE.CellCheck[4;":RowPos:"]" :@VM: 1 PropArray<-1> = "OLE.CellCheck[5;":RowPos:"]" :@VM: 0 End SRP_Set_Prop_Array(PropArray) Set_Property(@Window, "SAVEWARN", Yes$) End return Delete_Audit_Table: *------------------------------------------------------------------------------------------------------------------------------------- * Deletes the selected table(s) and redefines the database *------------------------------------------------------------------------------------------------------------------------------------- AuditTableName = "AUDIT_":TableName Set_Status(FALSE$) Delete_Table(AuditTableName, 0, 0) Set_Status(FALSE$) Define_Database(@DBID, TRUE$, "", "") return Get_Dict_Items: CurTable = Get_Property(CtrlEntID, "OLE.CellText[1;":RowPos:"]") CurPosInfo = Get_Property(CtrlEntID, "OLE.CellText[2;":RowPos:"]") RowCounter = 1 // The %FIELDS% stores all the column names and column positions for the entire table. Open "DICT.":CurTable to @DICT then ReadO Fields from @DICT, "%FIELDS%" else Fields = "" Display_list = "" CurPosList = "" Field_list = Fields<3> DataType = Fields<4> Pos_list = Fields<5> Num_fields = Count(Field_list, @VM) + (Field_list NE "") // Only allow those data Non-ID fields be shown in the popup. For Fields_loop = 1 to Num_fields If DataType<0, Fields_loop> EQ "F" then If Pos_list<0, Fields_loop> GT 0 then Display_list = Field_list<0, Fields_loop> CurPosList = Pos_list<0, Fields_loop> RowCounter += 1 end end Next Fields_loop // Pre-select all columns currently in the record. CurSelInfo = "" Swap "," with @FM in CurPosInfo NumCols = Count(CurPosInfo, @FM) + (CurPosInfo NE "") For ColPos = 1 to NumCols CurPos = CurPosInfo Locate CurPos in CurPosList using @FM setting ListPos then CurSelInfo<0, -1> = ListPos end Next ColPos Original_list = Display_list Transfer Display_list to Text GoSub First_Caps Transfer Text to Display_list Swap @FM with @VM in Display_list End Else @DICT = "" Fields = "" M_st = "" M_st<1> = "There are Dictionary Table defined for ":CurTable:"." M_st<4> = "*" M_st<8> = "L" M_st<9> = Msg_light_grey$ M_st<11> = 350 M_st<12> = "Record Search" rv = Msg("", M_st) End return Convert_Cols: If Cols then Set_Property(@Window, "SAVEWARN", Yes$) SelectedPos = "" NumCols = Count(Cols, @VM) + (Cols NE "") For ColLoop = 1 to NumCols CurCol = Cols<0, ColLoop> Locate CurCol in Display_list using @VM setting ListPos then SelectedPos<0, -1> = CurPosList end Next ColLoop Swap @VM with @RM in SelectedPos SelectedPos := @RM V119("S", "", "A", "R", SelectedPos, Flag) Convert @RM to "," in SelectedPos SelectedPos[-1, 1] = "" Set_Property(CtrlEntId, "OLE.CellText[2;":RowPos:"]", SelectedPos) End return Add_MFS: *------------------------------------------------------------------------------------------------------------------------------------- * Creates the Audit_Table, Adds the Audit_MFS *------------------------------------------------------------------------------------------------------------------------------------- * Create Audit Table AttribList = "1000,400,10,1024,80" Convert "," to @FM in AttribList TableLoc = "" AuditTable = "AUDIT_":TableName Attach_Table("APPDATA", AuditTable, "", "") * Define or attach a database TestTable = @AppId<1>:"*DBTABLE**":AuditTable rv = TableExists(TestTable) If rv EQ No$ Then Open "SYSREPOS" to SysReposName Then Read TestRecord From SysReposName, TestTable Then Attach_Table(TestRecord<4,1>, AuditTable, TestRecord<4,3>, "") If Get_Status(StatusCode) Then // Incase the process failed to attach the audit table. Will Create/Recreate the Audit Table Create_Table("APPDATA", AuditTable, Yes$, @APPID<1>, AttribList, "") Create_Table("APPDATA", AuditTable, "", @APPID<1>, AttribList, "") End Else Define_Database(TestRecord<4,3>, 0, "", "") End End Else * Create the Audit Table Create_Table("APPDATA", AuditTable, Yes$, @APPID<1>, AttribList, "") Create_Table("APPDATA", AuditTable, "", @APPID<1>, AttribList, "") End End End * first remove Old Audit Manager (in case it's in the media map) MFSName = "AUDIT_MFS" Set_Status(FALSE$) Set_MFS(TableName, MFSName, 5) * Second current Audit Manager MFS it (in case it is already in the media map) GoSub Get_MFS_Name * MFSName = "AUDIT_MANAGER_MFS*":@APPID<1> Set_Status(FALSE$) Set_MFS(TableName, MFSName, 5) * Now add the MFS Set_Status(FALSE$) Set_MFS(TableName, MFSName, 1) If Get_Status(Code) Then ErrorMsg = "AUDIT" Gosub MsgAlert End * update database definition Set_Status(FALSE$) Define_Database(@DBID, TRUE$, "", "") If Get_Status(Code) Then ErrorMsg = "DEFINE" Gosub MsgAlert End Else * Generating Dictionary Items Gosub Table_Format_Array End return Remove_MFS: *------------------------------------------------------------------------------------------------------------------------------------- * Removes MFS from the RevTable *------------------------------------------------------------------------------------------------------------------------------------- GoSub Get_MFS_Name Set_Status(FALSE$) Set_MFS(TableName, MFSName, 5) return Table_Format_Array: *------------------------------------------------------------------------------------------------------------------------------------- * Creates the Dictionary Items for the Audit_Table *------------------------------------------------------------------------------------------------------------------------------------- v.Array = "" id.Array.Id = "ID" v.Array<1,1> = "F" v.Array<1,2> = 0 v.Array<1,3> = "Id" v.Array<1,4> = "S" v.Array<1,5> = 0 v.Array<1,9> = "L" v.Array<1,10> = 20 v.Array<1,12> = "VARCHAR(255)" v.Array<1,28> = 1 v.Array<1,31> = 0 v.Array<1,34> = 0 di.Array.Id = "DATE_IN" v.Array<2,1> = "F" v.Array<2,2> = 1 v.Array<2,3> = "Date In" v.Array<2,4> = "M" v.Array<2,7> = "D/4" v.Array<2,9> = "L" v.Array<2,10> = 20 v.Array<2,11> = "(D)" v.Array<2,12> = "VARCHAR(255)" v.Array<2,28> = 1 v.Array<2,31> = 0 v.Array<2,34> = 0 ti.Array.Id = "TIME_IN" v.Array<3,1> = "F" v.Array<3,2> = 2 v.Array<3,3> = "Time In" v.Array<3,4> = "M" v.Array<3,7> = "MT" v.Array<3,9> = "L" v.Array<3,10> = 20 v.Array<3,11> = "(MT)" v.Array<3,12> = "VARCHAR(255)" v.Array<3,28> = 1 v.Array<3,31> = 0 v.Array<3,34> = 0 un.Array.Id = "USER_NAME" v.Array<4,1> = "F" v.Array<4,2> = 3 v.Array<4,3> = "User Name" v.Array<4,4> = "M" v.Array<4,9> = "L" v.Array<4,10> = 20 v.Array<4,12> = "VARCHAR(255)" v.Array<4,28> = 1 v.Array<4,31> = 0 v.Array<4,34> = 0 sn.Array.Id = "STATION" v.Array<5,1> = "F" v.Array<5,2> = 4 v.Array<5,3> = "Station Name" v.Array<5,4> = "M" v.Array<5,9> = "L" v.Array<5,10> = 20 v.Array<5,12> = "VARCHAR(255)" v.Array<5,28> = 1 v.Array<5,31> = 0 v.Array<5,34> = 0 ma.Array.Id = "MAC_ADDRESS" v.Array<6,1> = "F" v.Array<6,2> = 5 v.Array<6,3> = "Mac Address" v.Array<6,4> = "M" v.Array<6,9> = "L" v.Array<6,10> = 20 v.Array<6,12> = "VARCHAR(255)" v.Array<6,28> = 1 v.Array<6,31> = 0 v.Array<6,34> = 0 pn.Array.Id = "PROGRAM_NAME" v.Array<7,1> = "F" v.Array<7,2> = 6 v.Array<7,3> = "Program Name" v.Array<7,4> = "M" v.Array<7,9> = "L" v.Array<7,10> = 20 v.Array<7,12> = "VARCHAR(255)" v.Array<7,28> = 1 v.Array<7,31> = 0 v.Array<7,34> = 0 ln.Array.Id = "MARKER" v.Array<8,1> = "F" v.Array<8,2> = 7 v.Array<8,3> = "Marker" v.Array<8,4> = "M" v.Array<8,9> = "R" v.Array<8,10> = 20 v.Array<8,12> = "VARCHAR(255)" v.Array<8,28> = 1 v.Array<8,31> = 0 v.Array<8,34> = 0 at.Array.Id = "ACTIVITY" v.Array<9,1> = "F" v.Array<9,2> = 8 v.Array<9,3> = "Activity" v.Array<9,4> = "M" v.Array<9,9> = "L" v.Array<9,10> = 20 v.Array<9,12> = "VARCHAR(255)" v.Array<9,28> = 1 v.Array<9,31> = 0 v.Array<9,34> = 0 v.Array.Id = "" v.Array.Id<1> = id.Array.Id v.Array.Id<2> = di.Array.Id v.Array.Id<3> = ti.Array.Id v.Array.Id<4> = un.Array.Id v.Array.Id<5> = sn.Array.Id v.Array.Id<6> = ma.Array.Id v.Array.Id<7> = pn.Array.Id v.Array.Id<8> = ln.Array.Id v.Array.Id<9> = at.Array.Id status = "" Title = "" type = "D" DictTable = "DICT.":AuditTable Open DictTable to vTable Then For X = 1 to 9 dict.Array = v.Array Convert @VM TO @FM IN dict.Array Write Dict.Array to vTable, v.Array.Id Then RTP5(AuditTable, v.Array.Id, Title , Status, Type) End Else ErrorMsg = "WRITE" RecId = v.Array.Id Gosub MsgAlert End Next X End Else ErrorMsg = "OPEN" TableName = DictTable Gosub MsgAlert End return MsgAlert: *------------------------------------------------------------------------------------------------------------------------------------- * *------------------------------------------------------------------------------------------------------------------------------------- Error = "" Mess = "" Mess = "BO" Mess = "!" Mess = "Audit Manager" Begin Case Case ErrorMsg = "WARNING" Mess = "BNY" Error = "Changing the status to Remove will|delete the audit trail for the ":TableName:" table.||Are you sure you want to proceed?" Case ErrorMsg = "UPDATE" Error = "Table ":TableName:" is not an available option." Case ErrorMsg = "UPDATE2" Error = "Table ":TableName:" is a duplicate entry" Case ErrorMsg = "OPEN" Error = "Unable to OPEN the ": TableName: " table." Case ErrorMsg = "READ" Error = "Unable to Read ":RecId:" Record." Case ErrorMsg = "WRITE" Error = "Unable to Write ":RecId:" Record." Case ErrorMsg = "AUDIT" Error = "An error occurred adding the MFS to the ": TableName: " table.":@TM:@TM:"Error Code: ": Code<1,1,1> Case ErrorMsg = "DEFINE" Error = "An error occurred adding the MFS to the ": TableName: " table.":@TM:@TM:"Error Code: ": Code<1,1,1> End Case Mess = Error retVal = Msg("", Mess) return Get_MFS_Name: NumApps = Count(@APPID, @FM) + (@APPID NE "") For i = 1 to NumApps SysObjKey = "$AUDIT_MANAGER_MFS":"*":@APPID ObjExists = Xlate("SYSOBJ", SysObjKey, 0, "X") Until ObjExists Next i MFSName = "AUDIT_MANAGER_MFS*":@APPID return