Compile subroutine Create_Table_In_SQL(Table, GenerateCodeOnly) /*****************************************************************************\ This is a utility function. Using the table's dictionary, it creates a basic matching table in the SQL database, omitting explicit multivalue and symbolic fields. Simply makes work a little faster. PARAMETERS: Table - The table for which code and sql tables are to be created. GenerateCodeOnly - Set to 1 to generate code and not sql tables. Set to 2 to generate delete code only and not sql tables. History ------- 04/12/2010 KRF Original Programmer 04/22/2010 KRF Added logic to rename DESC to DESCRIPTION to avoid SQL errors 07/12/2010 KRF Updated to handle multiple primary keys 09/08/2010 KRF Swapped FIELDCOUNT with field count + 1 to make sure records with undocumented extra fields do not cause the SQL statements to fail. 09/21/2010 KRF Added support for generating DELETE subroutine \*****************************************************************************/ $insert Microsoft_Ado_Equates If Assigned(Table) else Table = "" If Assigned(GenerateCodeOnly) else GenerateCodeOnly = 0 Declare subroutine SRP_Com, Rlist, Repository, SRP_Editor_Open Declare function SRP_Com, Max, Repository Ans = "" // Make sure table is uppercase Convert @LOWER_CASE to @UPPER_CASE in Table // Get the list of reserved keywords ReservedWords = Xlate("SYSENV", "SQL_RESERVED_WORDS", "", "X") // The expected name of the handler Handler = "COPY_":Table:"_RECORD_TO_SQL" Open "DICT.":Table to hDict then // Connect to the ODBC If SRP_Com(Connection, "CREATE", "ADODB.Connection") then // Connect to the database via ODBC SRP_Com(Connection, "SET", "Mode", adModeShareDenyNone) SRP_Com(Connection, "SET", "CursorLocation", adUseClient) If SRP_Com(Connection, "CALL", "Open", "LSL2SQL", "srpadmin", "0okm9ijn") EQ "" then // Get single-valued fields in order of position ClearSelect Rlist("SELECT DICT.":Table:" BY COLUMN_POS BY F5 WITH COLUMN_TYPE = 'F' AND WITH F4 = 'S'", 5, "", "", "") // As we create the script, build a simple list of keys and data fields, used to generate code KeyList = "" FieldList = "" // While we're at it, get the lengths of the longest key and field, which will help in formatting the generated code MaxKeyLen = 0 NumKeys = 0 MaxFieldLen = 0 MaxFieldPos = 0 // Delimite the table if necessary Locate Table in ReservedWords using @FM setting Pos then TableName = Table:"_TABLE" end else TableName = Table end // Create script Script = "CREATE TABLE ":TableName:" (" Done = 0 Loop ReadNext Key else Done = 1 Until Done // Escape reserved words Locate Key in ReservedWords using @FM setting Pos then KeyName = "[":Key:"]" end else KeyName = Key end // The column name and type Read Rec from hDict, Key then Script := KeyName:" " GoSub AddType end // The Not Null field If Rec<31> EQ "1" then Script := " NOT NULL" end // Set as primary key if necessary If Rec<2> EQ "0" then * Script := " PRIMARY KEY" KeyList := KeyName:@VM:FormatCode:@VM:FormatAux:@FM MaxKeyLen = Max(MaxKeyLen, Len(KeyName)) NumKeys += 1 end else FieldList := KeyName:@VM:FormatCode:@VM:FormatAux:@VM:Rec<2>:@FM MaxFieldLen = Max(MaxFieldLen, Len(KeyName)) MaxFieldPos = Max(MaxFieldPos, Rec<2>) end // Assume another field following Script := ", " Repeat // Add primary keys If NumKeys GT 0 then Script := " CONSTRAINT pk_":TableName:" PRIMARY KEY (" For iKey = 1 to NumKeys KeyName = KeyList If iKey GT 1 then Script := ", ":KeyName end else Script := KeyName end Next iKey Script := ")" end else // Remove the last comma and close the script Script[-2, 2] = "" end Script := ")" * debug // Remove trailing @FMs in the key and field lists KeyList[-1, 1] = "" FieldList[-1, 1] = "" // Run the script and/or generate the code If GenerateCodeOnly then GoSub Generate_Code end else Result = SRP_Com(Connection, "CALL", "Execute", Script) If Result NE 0 then SRP_Com(Result, "RELEASE") GoSub Generate_Code end else Call Msg(@Window, "Error creating table ":TableName:"||Script = ":Quote(Script):"||":SRP_Com(Connection, "ERROR")) end end end else Ans = SRP_Com(Connection, "ERROR") end SRP_Com(Connection, "CALL", "Close") SRP_Com(Connection, "RELEASE") end end Return Ans AddType: SqlType = "varchar(50)" FormatCode = "STR" FormatAux = "" ColumnType = Rec<12> ColumnTypeName = ColumnType[1, '('] Begin Case Case ColumnTypeName _EQC "BOOLEAN" SqlType = "bit" FormatCode = "BIT" Case ColumnType _EQC "CHAR" SqlType = "char(1)" Case ColumnTypeName _EQC "DATE" SqlType = "datetime" FormatCode = "DATE" Case ColumnTypeName _EQC "DATETIME" SqlType = "datetime" FormatCode = "DATETIME" Case ColumnTypeName _EQC "DECIMAL" Format = Rec<7> DecPlaces = 6 If Format[1, 2] EQ "MD" then DecPlaces = Format[3, 1] end SqlType = "decimal(15, ":DecPlaces:")" FormatCode = "DEC" FormatAux = DecPlaces Case ColumnTypeName _EQC "DOLLARS" SqlType = "money" Case ColumnTypeName _EQC "FLOAT" SqlType = "float" Case ColumnTypeName _EQC "INTEGER" SqlType = "int" FormatCode = "INT" Case ColumnTypeName _EQC "TEXT" SqlType = "text" Case ColumnTypeName _EQC "TIME" SqlType = "datetime" FormatCode = "TIME" Case ColumnTypeName _EQC "VARBINARY" SqlType = "varbinary(50)" End Case Script := SqlType return Generate_Code: // Determine whether to use the normal template or the one that supports MV fields ClearSelect RList("SELECT 1 DICT.":Table:" WITH F4 = 'M'", 5, "", "", "") ReadNext Key then TemplateName = "TEMPLATE_COPY_RECORD_TO_SQL_MV" DeleteTemplateName = "TEMPLATE_DELETE_RECORD_FROM_SQL_MV" end else TemplateName = "TEMPLATE_COPY_RECORD_TO_SQL" DeleteTemplateName = "TEMPLATE_DELETE_RECORD_FROM_SQL" end // Load the template Template = Xlate("SYSENV", TemplateName, "", "X") DeleteTemplate = Xlate("SYSENV", DeleteTemplateName, "", "X") Insert = "" Keys = "" DataFields = "" // Determine if there is an insert If Xlate("SYSPROCS", Table:"_EQUATES*LSL2", "", "X") NE "" then Insert = "$insert ":Table:"_EQUATES":\0D0A0D0A\ end else If Xlate("SYSPROCS", Table:"_EQU*LSL2", "", "X") NE "" then Insert = "$insert ":Table:"_EQU":\0D0A0D0A\ end end // Build Keys KeyListCount = Count(KeyList, @FM) + (KeyList NE "") If KeyListCount GT 0 then If KeyListCount EQ 1 then Name = KeyList<1, 1> Format = KeyList<1, 2> Aux = KeyList<1, 3> Keys := 'Keys = "':Name:'":@VM:SQL_Format(Key, "':Format If Aux NE "" then Keys := '", "':Aux end Keys := '")' end else For iKeyList = 1 to KeyListCount Name = KeyList Format = KeyList Aux = KeyList Keys := 'Keys ' If iKeyList = 1 then Keys := ' =' end else Keys := ':=' end Keys := ' "':Name:'"':Str(" ", MaxKeyLen - Len(Name)):':@VM:SQL_Format(Field(Key, "*", ':iKeyList:'), "':Format If Aux NE "" then Keys := '", "':Aux end If iKeyList EQ KeyListCount then Keys := '")' end else Keys := '"):@FM':\0D0A\ end Next iKeyList end end // Build Fields FieldListCount = Count(FieldList, @FM) + (FieldList NE "") If FieldListCount GE 1 then For iFieldList = 1 to FieldListCount Name = FieldList Format = FieldList Aux = FieldList Pos = FieldList DataFields := 'DataFields ' If iFieldList = 1 then DataFields := ' =' end else DataFields := ':=' end DataFields := ' "':Name:'"':Str(" ", MaxFieldLen - Len(Name)):':@VM:SQL_Format(Rec(' If Insert EQ "" then DataFields := Pos:'), ':Str(" ", Len(MaxFieldPos) - Len(Pos)) end else DataFields := Table:'_':Name:'$), ':Str(" ", MaxFieldLen - Len(Name)) end DataFields := '"':Format If Aux NE "" then DataFields := '", "':Aux end If iFieldList EQ FieldListCount then DataFields := '")' end else DataFields := '"):@FM':\0D0A\ end Next iKeyList end // Swaps for COPY template Swap "%TABLE%" with Table in Template Swap "%TABLE_NAME%" with TableName in Template Swap "%INSERT%" with Insert in Template Swap "%FIELDCOUNT%" with (MaxFieldPos + 1) in Template Swap "%DATE%" with OConv(Date(), "D4/") in Template Swap "%KEYS%" with Keys in Template Swap "%DATAFIELDS%" with DataFields in Template // Swaps for DELETE template Swap "%TABLE%" with Table in DeleteTemplate Swap "%TABLE_NAME%" with TableName in DeleteTemplate Swap "%DATE%" with OConv(Date(), "D4/") in DeleteTemplate Swap "%KEYS%" with Keys in DeleteTemplate // Create and open COPY template EntName = "COPY_":Table:"_RECORD_TO_SQL" EntId = "LSL2*STPROC**":EntName Source = Repository("ACCESS", EntId) If Get_Status(StatusCode) then Repository("NEW", EntId, "", 1, 1, "", "", "", "", "", EntName, Template) end SRP_Editor_Open("Procedure", EntId) // Create and open DELETE template EntName = "DELETE_":Table:"_RECORD_FROM_SQL" EntId = "LSL2*STPROC**":EntName Source = Repository("ACCESS", EntId) If Get_Status(StatusCode) then Repository("NEW", EntId, "", 1, 1, "", "", "", "", "", EntName, DeleteTemplate) end SRP_Editor_Open("Procedure", EntId) return