Compile function SQL_Write(Connection, TableName, Keys, DataFields) /*****************************************************************************\ Writes a set of field-value pairs to the SQL connection. History ------- 04/05/2010 KRF Original Programmer 09/24/2010 KRF Added special check for special case where insert fails because record already exists \*****************************************************************************/ $insert Microsoft_Ado_Equates If Assigned(Connection) else Connection = 0 If Assigned(TableName) else TableName = "" If Assigned(Keys) else Keys = "" If Assigned(DataFields) else DataFields = "" Declare subroutine SRP_Com Declare function SRP_Com, SRP_Rotate_Array Ans = "" // Rebuild the data field array omitting ones with blank values NumDataFields = Count(DataFields, @FM) + (DataFields NE "") DataFieldsSource = DataFields DataFields = "" For iDataField = 1 to NumDataFields DataField = DataFieldsSource If DataField<1, 2> NE "" then DataFields<-1> = DataField end Next iDataField // Create the where clause expression from the array of keys KeyExpression = Keys Swap @VM with " = " in KeyExpression Swap @FM with " AND " in KeyExpression // See if the record already exists Script = "Select Count(*) From ":TableName:" where ":KeyExpression AttemptsBeforeFailure = 5 Attempts = 0 ErrorMessage = '' RecordExists = 0 Loop Attempts += 1 RecordSetResult = SRP_Com(Connection, "CALL", "Execute", Script) If SRP_COM('', 'ERROR') then ErrorMessage = 'Query failed to execute' end else RecordExists = SRP_Com(RecordSetResult, "CALL", "GetString", 2, 1, @FM, @RM)[1, @RM] end Until ( (ErrorMessage EQ '') or (Attempts GT AttemptsBeforeFailure) ) Repeat SRP_Com(RecordSetResult, "RELEASE") Script = "" If RecordExists then Operation = "Update" GoSub Do_Update GoSub Run_Script end else Operation = "Insert" GoSub Do_Insert GoSub Run_Script // SPECIAL CASE: Insert might fail if record didn't exist before SQL_WRITE started but // existed by the time the Insert was executed. If Ans NE "" then If IndexC(Ans, "Cannot insert duplicate key in object", 1) then Operation = "Update After Failed Insert" // Clear Ans because the failed insert was a false positive. Ans = '' GoSub Do_Update GoSub Run_Script end end end Return Ans Run_Script: // Run the script If Script then RecordSetResult = SRP_Com(Connection, "CALL", "Execute", Script) If RecordSetResult NE 0 then SRP_Com(RecordSetResult, "RELEASE") end else DataOutput = "" Pos = 1 Loop DataField = DataFields[Pos, @FM] Pos = Col2() + 1 Until DataField EQ "" DataFieldName = DataField[1, @VM] DataFieldData = DataField[Col2() + 1, @FM] LenDataFieldData = Len(DataFieldData) Swap \0D0A\ with @TM in DataFieldData DataOutput := DataFieldName:", ":DataFieldData:", Len=":LenDataFieldData:@SVM Repeat DataOutput[-1, 1] = "" Swap \0D0A\ with @TM in Script Ans = "Error writing to ":TableName:" where ":KeyExpression:@VM:Operation:@VM:SRP_Com(Connection, "ERROR"):@VM:Script:@VM:DataOutput end end return Do_Update: If DataFields NE "" then // Initialize the list of names and values NameList = "" ValueList = "" // Separate the array of keys into parallel lists of key names and key values If Keys NE "" then KeyArray = SRP_Rotate_Array(Keys) NameList = KeyArray<1> ValueList = KeyArray<2> end // Separate the array of data fields into parallel lists of fields names and values If DataFields NE "" AND ValueList NE "" then DataFieldsRotated = SRP_Rotate_Array(DataFields) If NameList EQ "" then NameList = DataFieldsRotated<1> end else NameList := @VM:DataFieldsRotated<1> end If ValueList EQ "" then ValueList = DataFieldsRotated<2> end else ValueList := @VM:DataFieldsRotated<2> end end // Convert the multivalue lists into comma delimited ones Swap @VM with ", " in NameList // Convert dates and times so they match what we'd get from SQL NewValueList = "" LenValueList = Len(ValueList) Pos = 1 Loop CurrValue = ValueList[Pos, @VM] Pos = Col2() + 1 If CurrValue[1, 1] EQ "'" AND CurrValue[-1, 1] EQ "'" then CurrValue[1, 1] = "" CurrValue[-1, 1] = "" If (Count(CurrValue, "-") EQ 2 OR Count(CurrValue, ":") EQ 3) AND Count(CurrValue, ".") EQ 0 AND Num(CurrValue[1, 4]) AND Num(CurrValue[5, 2]) AND Num(CurrValue[8, 2]) then Invalue = IConv(CurrValue[6, 5]:"-":CurrValue[1, 4]:CurrValue[11, 99], "DT") If Len(Invalue) then CurrValue = OConv(Invalue, "DT4/^HS") CurrValue[-2, 0] = " " CurrValue[12, 2] = Int(CurrValue[12, 2]) CurrValue[4, 2] = Int(CurrValue[4, 2]) CurrValue[1, 2] = Int(CurrValue[1, 2]) end else Invalue = IConv(CurrValue[6, 5]:"-":CurrValue[1, 4], "D") If Len(Invalue) then CurrValue = Int(CurrValue[6, 2]):"/":Int(CurrValue[9, 2]):"/":CurrValue[1, 4] end else Invalue = IConv(CurrValue, "MT") If Len(Invalue) then CurrValue = OConv(Invalue, "MTHS") CurrValue = "1/1/1900 ":Int(CurrValue[1, 2]):CurrValue[3, Len(CurrValue) - 4]:" ":CurrValue[-2, 2] end end end end end NewValueList := CurrValue:@FM Until Pos GE LenValueList Repeat NewValueList[-1, 1] = "" // See if the record already exists Script = "Select ":NameList:" From ":TableName:" where ":KeyExpression RecordSetResult = SRP_Com(Connection, "CALL", "Execute", Script) Record = SRP_Com(RecordSetResult, "CALL", "GetString", 2, 1, @FM, @RM)[1, @RM] SRP_Com(RecordSetResult, "RELEASE") Script = "" If RecordExists NE "" then // Remove "empty" dates Swap @FM:"1/1/1900":@FM with @FM:@FM in Record If Record[-8, 8] EQ "1/1/1900" then Record[-8, 8] = "" // Only do the update if there's a difference If NewValueList NE Record then // Convert the array of data fields into a list of assignments DataFieldsScript = DataFields Swap @VM with " = " in DataFieldsScript Swap @FM with ", " in DataFieldsScript Script = "Update ":TableName:" Set ":DataFieldsScript:" where ":KeyExpression end else Script = "" end end end return Do_Insert: // Since an INSERT statement lists names separate from value, rotate the arrays // of keys and data fields so that it's easier to extract them separately // Initialize the list of names and values NameList = "" ValueList = "" // Separate the array of keys into parallel lists of key names and key values If Keys NE "" then KeyArray = SRP_Rotate_Array(Keys) NameList = KeyArray<1> ValueList = KeyArray<2> end // Separate the array of data fields into parallel lists of fields names and values If DataFields NE "" AND ValueList NE "" then DataFieldsRotated = SRP_Rotate_Array(DataFields) If NameList EQ "" then NameList = DataFieldsRotated<1> end else NameList := @VM:DataFieldsRotated<1> end If ValueList EQ "" then ValueList = DataFieldsRotated<2> end else ValueList := @VM:DataFieldsRotated<2> end end // Convert the multivalue lists into comma delimited ones Swap @VM with ", " in NameList Swap @VM with ", " in ValueList // Continue only if the lists are not empty If NameList NE "" AND ValueList NE "" then Script = "Insert into ":TableName:" (":NameList:") values (":ValueList:")" end return