//***************************************************************************** //*** cDbImport.pkg *** //*** *** //*** Author: Bob Worsley *** //*** May 2004 *** //*** *** //*** Purpose: *** //*** Class to import CSV or text data into a data file *** //*** *** //*** Updates: *** //*** 08/07/2004 RLW If # of columns in input file less than # in data *** //*** file, Last input data column written to all *** //*** remaining data file columns *** //*** *** //***************************************************************************** Use UI #IFDEF Is$WINDOWS Use Windows #IF (FMAC_VERSION < |CI8) Use Workspc #ELSE Use cApplication #ENDIF #ENDIF //Use CLI Use Set Use Case.mac Use flexml.pkg Use DataDict.pkg Use FileOpenExclusiveTest.pkg Use Batchdd.pkg Use Cursor.pkg //*** Channels Define iProgChan For 1 Define iImpChan For 2 Define iFlatChan For 3 Define iHexChan For 4 //*** Prototypes Register_Procedure ShowLine String sLine //***************************************************************************** //*** Object : oDbImport *** //*** Superclass: BusinessProcess *** //*** *** //*** Purpose: *** //*** The import Process *** //***************************************************************************** Class cDBImport Is A BusinessProcess Procedure Construct_object Forward Send Construct_object Property String psLogFile Public "dbImport.log" Property String psImportOrCode Public "" Property Integer phmShowMessage Public MSG_ShowLine Property Integer pbVerbose Public DFTRUE Property Integer pbOneTransaction Public DFFALSE //*** Private properties Property Integer Private.piLastPerc Public 0 Move Current_Object To Error_Object_Id Object oImport_DD Is A DataDictionary End_Object End_Procedure // Construct_object //AB-DDOStart //AB-DDOEnd //AB-StoreStart //----------------------------------------------------------------------------------> //*** Function: ParsePath //*** Purpose: In case there are multiple paths inside the source path, //*** we parse off the first one to write the source //----------------------------------------------------------------------------------> Function ParsePath Returns String Integer iPos String sSrcPath Handle hoWorkspace If (giIn_VDF12) Begin Get phoWorkspace of oApplication to hoWorkspace Move (psAppSrcpath(hoWorkspace)) to sSrcPath End Else Get psAppSrcPath of oWorkSpace to sSrcPath Move (Pos(";", sSrcPath)) to iPos If (iPos) Move (Left(sSrcPath, (iPos-1))) To sSrcPath Function_Return sSrcPath End_Function //----------------------------------------------------------------------------------> //*** Function: ConvertHexToAscii //*** Purpose: There's only one way in DF to convert hex, Read_Hex and Write_Hex. // Unfortunately these only work with a device, so when the hex data // is already read and in a variable, we use the clipboard to convert it. //----------------------------------------------------------------------------------> Function ConvertHexToAscii String sField Returns String String sNewField Direct_Output Channel iHexChan "Clipboard:" Writeln Channel iHexChan sField Close_Output Channel iHexChan Direct_Input Channel iHexChan "Clipboard:" Read_Hex Channel iHexChan sNewField 0 Close_Input Channel iHexChan Function_Return sNewField End_Function //----------------------------------------------------------------------------------> //*** Function: OnProcess // //*** Purpose: Standard Business Process method, calls all other routines. //----------------------------------------------------------------------------------> Procedure OnProcess String sTarget String sItemText String sWorkSpace String sFilePath String sFileType String sRootName String sDelimiter Integer iFile# Integer iIsAHeader Integer iImportOrCode Integer iZeroFile Integer iAddToIDE Integer iFileType Integer iReadHex Set Dynamic_Update_State To True Send Cursor_Wait To (Cursor_Control(Self)) Get psWorkspaceSelection To sWorkSpace //*** File Type Get psFileType To sFileType //*** with delimiter Get psDelimiter To sDelimiter //*** Do we have a header? Get Checked_State Of (oHeaderRowCheckbox(oImportFileType(Self))) To iIsAHeader //*** Program or import? Get Current_Radio Of (oImportOrCodeRadioGrp(oImportOrCode(Self))) To iImportOrCode Get piAddToIDE To iAddToIDE //*** Data file number Get piImportDataFileNumber To iFile# //*** Zero the data file Get piZeroFile To iZeroFile //*** Read text & binary as hex Get Checked_State Of (oHexCheckBox(oImportFileType(Self))) To iReadHex Get psImportFileName To sFilePath //*** Do we write code? If (iImportOrCode) Send CreateImportProgram sFileType ; iFile# iIsAHeader iZeroFile sWorkSpace sFilePath iAddToIDE iReadHex sDelimiter //*** or do we import with the wizard? Else Begin If (sFileType = "C" Or sFileType = "F"); Send ProcessImport_CSV_FFL iFile# iIsAHeader ; iZeroFile sWorkSpace sFilePath sFileType iReadHex sDelimiter If (sFileType = "X"); Send ProcessImport_XML iFile# iIsAHeader iZeroFile sWorkSpace sFilePath iReadHex End Send Cursor_Ready To (Cursor_Control(Self)) End_Procedure // OnProcess //----------------------------------------------------------------------------------> //*** Function: ProcessImport_CSV_FFL //*** Purpose : Does the comma delimited and fixed field length import //----------------------------------------------------------------------------------> Procedure ProcessImport_CSV_FFL Integer iFile# Integer iIsAHeader Integer iZeroFile String sWorkSpace ; String sFilePath String sFileType Integer iReadHex String sDelimiter Integer iNumberOfFields Integer iPos Integer iLines Integer iField Integer iCounter Integer iIndex Integer iItem Integer iFieldDataType Integer bOpen Integer iFieldLength Integer iFieldStart Integer iImportDD Integer iStatPnl Integer iUserCancel Integer iArrayItems Integer iArrayObj Integer iDelimiterPos String sFieldName String sRootName String sSrcPath String sIndex String sInput String sCRLF String sField String sText Boolean bErr Move (oFieldArray(Self)) To iArrayObj Get Item_Count Of iArrayObj To iArrayItems Move (Status_Panel(Self)) To iStatPnl Set Allow_Cancel_State Of iStatPnl To True Move (oImport_DD(Self)) To iImportDD Move (Character(13)+Character(10)) To sCRLF Move (ParsePath(Self)) To sSrcPath // Check one last time in case someone opened the file If (iZeroFile) Begin Move (DoCheckForExclusiveAccess(Self, iFile#)) To bOpen If (bOpen = Dffalse) Begin Send Stop_StatusPanel To iStatPnl Send Stop_Box "Zeroing has been selected, but the file is open, the process cannot continue." "ERROR!" Set pbComplete To False Procedure_Return End End Open iFile# Set Main_File Of oImport_DD To iFile# Set Main_DD To oImport_DD Set Server To oImport_DD Get_Attribute DF_FILE_NUMBER_FIELDS Of iFile# To iNumberOfFields Get_Attribute DF_FILE_ROOT_NAME Of iFile# To sRootName Send Initialize_StatusPanel To iStatPnl ("Importing "+sRootName) "" "" Send Start_StatusPanel To iStatPnl If (iIndex > 0) Move iIndex To sIndex Direct_Input Channel iImpChan sFilePath If (seqeof) Begin Send Stop_StatusPanel To iStatPnl Send Stop_Box ("Import file "+sFilePath+" not found!") "ERROR!" Close_Input Channel iImpChan Set pbComplete To False Procedure_Return End // Sample 100 lines Get Calc_Flat_File_Lines sFilePath 100 iFlatChan To iLines // Set all files to readonly except for the one we are importing Send SetFileModes giReadOnly Set_Attribute df_file_mode Of iFile# To df_filemode_default If (iZeroFile) ZeroFile iFile# If (iIsAHeader) Readln Channel iImpChan // Bypass the header record" If (iArrayItems > 0) Move (iArrayItems-1) To iNumberOfFields Repeat //-------------------------------------------------------------------> // CSV file type //-------------------------------------------------------------------> If (sFileType = "C") Begin Send Clear To iImportDD Readln Channel iImpChan sInput If (Not(seqeof)) Begin For iItem From 1 To iNumberOfFields // Use field array for limited fields If (iArrayItems > 0) Get Array_Value Of iArrayObj Item (iItem-1) To iField // or all fields Else Move iItem To iField Get_Attribute DF_FIELD_NAME Of iFile# iField To sFieldName Get_Attribute DF_FIELD_TYPE Of iFile# iField To iFieldDataType If (iFieldDataType <> DF_OVERLAP) Begin Move (Pos(sDelimiter, sInput)) To iDelimiterPos If (iDelimiterPos > 0) Begin Move (Left(sInput,(iDelimiterPos - 1))) To sField Move (Right(sInput,(length(sInput) - iDelimiterPos))) To sInput // Take out any double quotes if there Move (Replaces('"', sField, '')) To sField If (iFieldDataType = DF_TEXT Or iFieldDataType = DF_BINARY); Send DefineExtendedField To iImportDD iField // If set to read hex and we find that the data field is text or binary If (iReadHex And (iFieldDataType = DF_TEXT Or iFieldDataType = DF_BINARY)) Begin // Might have been able to use Read_Hex just above, except that we // don't know the length of the data between delimiters Move (ConvertHexToAscii(Self, sField)) To sText Set Field_Changed_Value Of iImportDD iField To sText End // Write it to the data file Else Set Field_Changed_Value Of iImportDD iField To sField End Else Begin // Last field Move (Replaces('"', sInput, '')) To sInput If (iReadHex And (iFieldDataType = DF_TEXT Or iFieldDataType = DF_BINARY)) Begin Send DefineExtendedField To iImportDD iField Move (ConvertHexToAscii(Self, sInput )) To sText Set Field_Changed_Value Of iImportDD iField To sText End Else Set Field_Changed_Value Of iImportDD iField To sInput Move "" to sInput End End Loop Get Request_Validate Of iImportDD To bErr If Not bErr Begin Send Request_Save To iImportDD End End End //-------------------------------------------------------------------> // Fixed field length //-------------------------------------------------------------------> If (sFileType = "F") Begin Send Clear To iImportDD Move 1 To iFieldStart Readln Channel iImpChan sInput If (Not(seqeof)) Begin If (iArrayItems > 0) Move (iArrayItems-1) To iNumberOfFields For iItem From 1 To iNumberOfFields // Use field array for limited fields If (iArrayItems > 0) Get Array_Value Of iArrayObj Item (iItem-1) To iField // or all fields Else Move iItem To iField Get_Attribute DF_FIELD_NAME Of iFile# iField To sFieldName Get_Attribute DF_FIELD_LENGTH Of iFile# iField To iFieldLength Get_Attribute DF_FIELD_TYPE Of iFile# iField To iFieldDataType If (iFieldDataType <> DF_OVERLAP) Begin Move (Mid(sInput, iFieldLength, iFieldStart)) To sField If (iFieldDataType = DF_TEXT Or iFieldDataType = DF_BINARY); Send DefineExtendedField To iImportDD iField // If set to read hex and we find that the data field is text or binary If (iReadHex And (iFieldDataType = DF_TEXT Or iFieldDataType = DF_BINARY)) Begin Move (ConvertHexToAscii(Self, sField)) To sText Send DefineExtendedField To iImportDD iField Set Field_Changed_Value Of iImportDD iField To sText End // Write it to the data file Else Set Field_Changed_Value Of iImportDD iField To sField Move (iFieldLength+iFieldStart) To iFieldStart End Loop Get Request_Validate Of iImportDD To bErr If Not bErr Begin Send Request_Save To iImportDD End End End //----------------------------------------------------------------------> Increment iCounter Send Update_StatusPanel To iStatPnl ("Record: "+String(iCounter)) Get Check_StatusPanel Of iStatPnl To iUserCancel If (iUserCancel) Send Stop_StatusPanel To iStatPnl Until (seqeof Or iUserCancel) // Set all files back to default mode Send SetFileModes giDefault Set pbComplete To True Close_Input Channel iImpChan Close iFile# End_Procedure //----------------------------------------------------------------------------------> //*** Function: ProcessImport_XML //*** Purpose : Does the XML import // Much of this code could have been combined with the CSV format as // it's exactly the same, but code readability would have suffered. //----------------------------------------------------------------------------------> Procedure ProcessImport_XML Integer iFile# Integer iIsAHeader Integer iZeroFile ; String sWorkSpace String sFilePath Integer iReadHex Integer iNumberOfFields Integer iPos Integer iField Integer iCounter Integer iIndex Integer bOK Integer iTotalRecords Integer hoRecord Integer iFieldDataType Integer bOpen Integer iImportDD Integer iStatPnl Integer iUserCancel Integer iArrayItems Integer iArrayObj Integer iItem String sFieldName String sRootName String sSrcPath String sIndex String sInput String sCRLF String sText Handle hoXML Handle hoList Handle hoRoot Boolean bErr Move (oFieldArray(Self)) To iArrayObj Get Item_Count Of iArrayObj To iArrayItems Move (Status_Panel(Self)) To iStatPnl Set Allow_Cancel_State Of iStatPnl To True Move (oImport_DD(Self)) To iImportDD Move (Character(13)+Character(10)) To sCRLF Move (ParsePath(Self)) To sSrcPath // Check one last time in case someone opened the file If (iZeroFile) Begin Move (DoCheckForExclusiveAccess(Self, iFile#)) To bOpen If (bOpen = DfFalse) Begin Send Stop_StatusPanel To iStatPnl Send Stop_Box "Zeroing has been selected, but the file is open, the process cannot continue." "ERROR!" Set pbComplete To False Procedure_Return End End Open iFile# Set Main_File Of oImport_DD To iFile# Set Main_DD To oImport_DD Set Server To oImport_DD Get_Attribute DF_FILE_NUMBER_FIELDS Of iFile# To iNumberOfFields Get_Attribute DF_FILE_ROOT_NAME Of iFile# To sRootName Send Initialize_StatusPanel To iStatPnl ("Importing "+sRootName) "" "" Send Start_StatusPanel To iStatPnl If (iIndex > 0) Move iIndex To sIndex Direct_Input Channel iImpChan sFilePath If (seqeof) Begin Send Stop_StatusPanel To iStatPnl Send Stop_Box ("Import file "+sFilePath+" not found!") "ERROR!" Close_Input Channel iImpChan Set pbComplete To False Procedure_Return End Close_Input Channel iImpChan // Set all files to readonly except for the one we are importing Send SetFileModes giReadOnly Set_Attribute df_file_mode Of iFile# To df_filemode_default If (iZeroFile) ZeroFile iFile# If (iIsAHeader) Readln Channel iImpChan // Bypass the header record" Get Create U_cXMLDOMDocument To hoXML Set psDocumentName Of hoXML To sFilePath Set pbValidateOnParse Of hoXML To True Get LoadXMLDocument Of hoXML To bOK If Not bOK Begin Send Stop_Box "XML loading error" "ERROR!" End If bOk Begin Get DocumentElement Of hoXML To hoRoot // create a collection node of all customers Get FindNodeList Of hoRoot "Row" To hoList Get NodeListLength Of hoList To iTotalRecords Decrement iTotalRecords // This is actually the number of records being imported For iCounter From 0 To iTotalRecords Get CollectionNode Of hoList iCounter To hoRecord Send Clear To iImportDD If (iArrayItems > 0) Move (iArrayItems-1) To iNumberOfFields // Import the whole record For iItem From 1 To iNumberOfFields // Use field array for limited fields If (iArrayItems > 0) Get Array_Value Of iArrayObj Item (iItem-1) To iField // or all fields Else Move iItem To iField Get_Attribute DF_FIELD_NAME Of iFile# iField To sFieldName Get_Attribute DF_FIELD_TYPE Of iFile# iField To iFieldDataType If (iFieldDataType <> DF_OVERLAP) Begin // Read the XML node Move "" To sInput Get ChildNodeValue Of hoRecord (Trim(sFieldName)) To sInput If (iFieldDataType = DF_TEXT Or iFieldDataType = DF_BINARY); Send DefineExtendedField To iImportDD iField // If set to read hex and we find that the data field is text or binary If (iReadHex And (iFieldDataType = DF_TEXT Or iFieldDataType = DF_BINARY)) Begin Move (ConvertHexToAscii(Self, sInput)) To sText Set Field_Changed_Value Of iImportDD iField To sText End // Write it to the data file Else Set Field_Changed_Value Of iImportDD iField To sInput End Loop Send Destroy To hoRecord Get Request_Validate Of iImportDD To bErr If Not bErr Begin Send Request_Save To iImportDD End Send Update_StatusPanel To iStatPnl ("Record: "+String(iCounter)) Get Check_StatusPanel Of iStatPnl To iUserCancel If (iUserCancel) Begin Send Stop_StatusPanel To iStatPnl Move (iTotalRecords+1) To iCounter End Loop Send Destroy To hoList End Send Destroy Of hoXML // Set all files back to default mode Send SetFileModes giDefault Set pbComplete To True Close_Input Channel iImpChan Close iFile# End_Procedure //----------------------------------------------------------------------------------> //*** Function: CreateImportProgram //*** Purpose : Creates an import program //----------------------------------------------------------------------------------> Procedure CreateImportProgram String sFileType Integer iFile# Integer iIsAHeader Integer iZeroFile ; String sWorkSpace String sFilePath Integer iAddToIDE Integer iReadHex String sDelimiter Integer iNumberOfFields Integer iPos Integer iField Integer iSegment Integer iFieldNumber Integer iNumSegments Integer iLastIndex Integer iIndex Integer iIsRecnum String sFieldName String sRootName String sSrcPath String sViewName String sProjectName String sGenfileName String sOutputFileName String sFileTypeId If (sFileType = "C") Move "CSV" To sFileTypeId If (sFileType = "F") Move "FFL" To sFileTypeId If (sFileType = "X") Move "XML" To sFileTypeId Open iFile# Get_Attribute DF_FILE_NUMBER_FIELDS Of iFile# To iNumberOfFields Get_Attribute DF_FILE_ROOT_NAME Of iFile# To sRootName Move (ParsePath(Self)) To sSrcPath Move ("_Import_"+sFileTypeId) To sOutputFileName Move (lowercase(sRootName+sOutPutFileName+".vw")) To sViewName Move (lowercase(sRootName+sOutPutFileName+".src")) To sGenfileName Move (lowercase(sRootName+sOutPutFileName)) To sProjectName //------------------------------------------------------------------------> // Source file //------------------------------------------------------------------------> Direct_Output Channel iProgChan (sSrcPath+"\"+lowercase(sGenFileName)) Writeln Channel iProgChan "use dfallent" If (sFileType = "X"); Writeln Channel iProgChan "use Flexml.pkg" Writeln Channel iProgChan "" #IF (FMAC_VERSION < |CI8) Writeln Channel iProgChan ('#REPLACE CURRENT$WORKSPACE '+'"'+sWorkSpace+'"') Writeln Channel iProgChan "" Writeln Channel iProgChan "Use Workspc.pkg" Writeln Channel iProgChan "" Writeln Channel iProgChan "Object ProgramWorkspace is a Workspace" Writeln Channel iProgChan " Set WorkspaceName to CURRENT$WORKSPACE" Writeln Channel iProgChan "End_Object" #ELSE Writeln Channel iProgChan "Use cApplication.pkg" Writeln Channel iProgChan "" Writeln Channel iProgChan "Set_Date_Attribute sysdate4_State to (TRUE)" Writeln Channel iProgChan "Set_Date_Attribute Date4_State to (TRUE)" Writeln Channel iProgChan "Set_Date_Attribute epoch_value to 30" Writeln Channel iProgChan "" Writeln Channel iProgChan "Object oApplication is a cApplication" Writeln Channel iProgChan "" Writeln Channel iProgChan " Set pbPreserveEnvironment To False" Writeln Channel iProgChan "" Writeln Channel iProgChan " Procedure OnCreate" Writeln Channel iProgChan (' Send DoOpenWorkspace '+'"'+sWorkSpace+'"') Writeln Channel iProgChan " End_Procedure" Writeln Channel iProgChan "" Writeln Channel iProgChan "End_Object // oApplication" Writeln Channel iProgChan "" #ENDIF Writeln Channel iProgChan "Object Main is a Panel" Writeln Channel iProgChan ' Set Label to "Import Program"' Writeln Channel iProgChan " Set Size To 200 325" Writeln Channel iProgChan "" Writeln Channel iProgChan " Object oClient_Area IS A AppClientArea" Writeln Channel iProgChan "" Writeln Channel iProgChan (' Use ' + sViewName) Writeln Channel iProgChan "" Writeln Channel iProgChan " End_Object" Writeln Channel iProgChan "" Writeln Channel iProgChan "End_Object // Main" Writeln Channel iProgChan "" Writeln Channel iProgChan ('Send Activate_o'+sProjectName+'_vw To (oClient_Area(Main(Self)))') Writeln Channel iProgChan "" Writeln Channel iProgChan "Start_UI" Close_Output Channel iProgChan //------------------------------------------------------------------------> // View file //------------------------------------------------------------------------> Direct_Output Channel iProgChan (sSrcPath+"\"+lowercase(sViewName)) Writeln Channel iProgChan ("//AB/ Project "+sProjectName) Writeln Channel iProgChan "//AB/ Object prj is a Dialog_Project" Writeln Channel iProgChan ("//AB/ Set ProjectName to "+sProjectName) Writeln Channel iProgChan ("//AB/ Set ProjectFileName to "+sViewName) Writeln Channel iProgChan '//AB/ Set GenerateFileName to "NONAME1"' Writeln Channel iProgChan "" Writeln Channel iProgChan "Register_Object oImportData" Writeln Channel iProgChan "" Writeln Channel iProgChan "//AB-StoreTopStart" Writeln Channel iProgChan "Define iFileChan for 1" Writeln Channel iProgChan "Define iHexChan for 2" Writeln Channel iProgChan "//AB-StoreTopEnd" Writeln Channel iProgChan "" Writeln Channel iProgChan "" Writeln Channel iProgChan "" Writeln Channel iProgChan ('DEFERRED_VIEW Activate_o'+sProjectName+'_vw FOR ;') Writeln Channel iProgChan ";" Writeln Channel iProgChan ('Object o'+sProjectName+'_vw is a dbView') Writeln Channel iProgChan " Set Size To 165 250" Writeln Channel iProgChan " Set Location To 1 1" Writeln Channel iProgChan "" Writeln Channel iProgChan " //AB-StoreTopStart" Writeln Channel iProgChan " Object oImport_DD is a DataDictionary" Writeln Channel iProgChan " End_Object" Writeln Channel iProgChan " //AB-StoreTopEnd" Writeln Channel iProgChan "" Writeln Channel iProgChan " Object oFileNameText Is A TextBox" // **WvA: 25-06-2004 Writeln Channel iProgChan " Set Size To 26 200" // Doubled height for text wrapping // removed comment from source, the studio doesn't like comment marks here. Writeln Channel iProgChan " Set Location To 30 -20 " // Negative compensates for 600 font Writeln Channel iProgChan " Set Auto_Size_State to False" Writeln Channel iProgChan " set Justification_Mode to jMode_Center" Writeln Channel iProgChan (' Set Label to '+'"'+'Import '+sFilePath+'"') Writeln Channel iProgChan " Set FontWeight to 600" Writeln Channel iProgChan " End_Object" Writeln Channel iProgChan "" Writeln Channel iProgChan " Object oInstructionsText Is A TextBox" Writeln Channel iProgChan " Set Size To 13 180" Writeln Channel iProgChan " Set Location To 50 30" Writeln Channel iProgChan " Set Auto_Size_State to False" Writeln Channel iProgChan ' Set Label To "Click Process to begin the import."' Writeln Channel iProgChan " Set FontWeight to 600" Writeln Channel iProgChan " End_Object" Writeln Channel iProgChan "" Writeln Channel iProgChan " Object oProcess_bn Is A Button" Writeln Channel iProgChan " Set Location To 128 133" Writeln Channel iProgChan ' Set Label To "Process"' Writeln Channel iProgChan "" Writeln Channel iProgChan " //AB-StoreStart" Writeln Channel iProgChan " Procedure OnClick" Writeln Channel iProgChan " Send OnProcess to oImportData" Writeln Channel iProgChan " Send Exit_Application" Writeln Channel iProgChan " End_Procedure" Writeln Channel iProgChan " //AB-StoreEnd" Writeln Channel iProgChan "" Writeln Channel iProgChan " End_Object" Writeln Channel iProgChan "" Writeln Channel iProgChan " Object oCancel_bn Is A Button" Writeln Channel iProgChan " Set Location To 128 189" Writeln Channel iProgChan ' Set Label To "Cancel"' Writeln Channel iProgChan "" Writeln Channel iProgChan " //AB-StoreStart" Writeln Channel iProgChan " Procedure OnClick" Writeln Channel iProgChan " Send Exit_Application" Writeln Channel iProgChan " End_Procedure" Writeln Channel iProgChan " //AB-StoreEnd" Writeln Channel iProgChan "" Writeln Channel iProgChan " End_Object" Writeln Channel iProgChan "" Writeln Channel iProgChan " //AB-StoreStart" If (sFileType = "C"); Send Write_CSV_Code iFile# sRootName iNumberOfFields sFieldName iIsAHeader iZeroFile sFilePath iIndex iReadHex If (sFileType = "X"); Send Write_XML_Code iFile# sRootName sFieldName iIsAHeader iZeroFile sFilePath iIndex iReadHex If (sFileType = "F"); Send Write_FFL_Code iFile# sRootName iNumberOfFields sFieldName iIsAHeader iZeroFile sFilePath iIndex iReadHex Writeln Channel iProgChan " //AB-StoreEnd" Writeln Channel iProgChan "" Writeln Channel iProgChan ('CD_End_Object // '+sViewName) Writeln Channel iProgChan "" Writeln Channel iProgChan "//AB/ End_Object // prj" Close_Output Channel iProgChan //------------------------------------------------------------------------> // Write to Abdata //------------------------------------------------------------------------> //If (iAddToIDE) Begin //Open (sSrcPath+"\abdata") as Abdata //Clear Abdata //Move 2 To AbData.Type //Move (sFileTypeId+" Import to file "+sRootName) To AbData.Description //Move sViewName To AbData.FileName //Lock //Find Eq AbData by Index.1 //Move (sProjectName+'_vw') To AbData.Object_Name //Move sGenfileName To AbData.GenFileName //Saverecord Abdata //Unlock //Close Abdata //End Set pbComplete To True End_Procedure //------------------------------------------------------------------------> // Common routines for all generated code //------------------------------------------------------------------------> //------------------------------------------------------------------------> // Some unused variables in this between the three routines, but doing // this is a little more efficient... //------------------------------------------------------------------------> Procedure Write_Variables Writeln Channel iProgChan " String sTempStr" Writeln Channel iProgChan " String sRootName" Writeln Channel iProgChan " String sFieldName" Writeln Channel iProgChan " String sFilePath" Writeln Channel iProgChan " String sField" Writeln Channel iProgChan " String sInput" Writeln Channel iProgChan " String sFieldList" Writeln Channel iProgChan " String sOrigFieldList" Writeln Channel iProgChan " string Semi$" Writeln Channel iProgChan " Integer iSemi" Writeln Channel iProgChan " Integer iCounter" Writeln Channel iProgChan " Integer iItem" Writeln Channel iProgChan " Integer iItems" Writeln Channel iProgChan " Integer iFieldStart" Writeln Channel iProgChan " Integer iField" Writeln Channel iProgChan " Integer iNumberOfFields" Writeln Channel iProgChan " Integer iFile#" Writeln Channel iProgChan " Integer iFieldLength" Writeln Channel iProgChan " Integer iFieldDataType" Writeln Channel iProgChan " Integer iImportDD" Writeln Channel iProgChan " Integer iArrayItems" Writeln Channel iProgChan " Integer iArrayObj" Writeln Channel iProgChan " Integer iStatPnl" Writeln Channel iProgChan " Integer iUserCancel" Writeln Channel iProgChan " Integer iRC" Writeln Channel iProgChan " Boolean bOk" Writeln Channel iProgChan " Boolean bErr" Writeln Channel iProgChan " Boolean bExclusive" Writeln Channel iProgChan " Handle hoXML" Writeln Channel iProgChan " Handle hoList" Writeln Channel iProgChan " Handle hoRoot" Writeln Channel iProgChan " Handle hoRecord" End_Procedure Procedure Write_Error_Routine Writeln Channel iProgChan " Property integer error_processing_state Public False" Writeln Channel iProgChan " Property Integer piOldErrorId Public 0" Writeln Channel iProgChan "" Writeln Channel iProgChan " Procedure Error_report Integer iErrNum Integer iErrLine String sErrText" Writeln Channel iProgChan " Integer iOrigErrorReport" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (error_processing_state(self)) Procedure_return" Writeln Channel iProgChan " Set error_processing_State to true" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (iErrNum <> 4177) Begin" Writeln Channel iProgChan " Get piOldErrorId to iOrigErrorReport" Writeln Channel iProgChan " Send Error_report to iOrigErrorReport iErrNum iErrLine sErrText" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan " Set error_processing_State to false" Writeln Channel iProgChan " End_procedure" Writeln Channel iProgChan "" End_Procedure Procedure Write_Zerofile_Error_Trapping Writeln Channel iProgChan " Set piOldErrorId to Error_object_id" Writeln Channel iProgChan " Move (Self) to Error_Object_Id" Writeln Channel iProgChan " Open iFile# mode df_exclusive" Writeln Channel iProgChan " If (found) Move (DFTrue) To bExclusive" Writeln Channel iProgChan " Move (piOldErrorId(Self)) to Error_Object_Id" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (bExclusive <> DfTrue) Begin" Writeln Channel iProgChan ' Send Stop_Box "Zeroing has been selected, but the file is open, the process cannot continue." "ERROR!"' Writeln Channel iProgChan " Procedure_Return" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" End_Procedure Procedure DD_And_Open_File String sFilePath Writeln Channel iProgChan " Move (oImport_DD(Self)) to iImportDD" Writeln Channel iProgChan " Set Main_File of iImportDD to iFile#" Writeln Channel iProgChan " Set Main_DD To iImportDD" Writeln Channel iProgChan " Set Server To iImportDD" Writeln Channel iProgChan "" Writeln Channel iProgChan " get_Attribute DF_FILE_NUMBER_FIELDS of iFile# to iNumberOfFields" Writeln Channel iProgChan " get_Attribute DF_FILE_ROOT_NAME of iFile# to sRootName" Writeln Channel iProgChan "" Writeln Channel iProgChan " // Test to see if the file exists" Writeln Channel iProgChan (' Direct_Input Channel iFileChan '+'"'+sFilePath+'"') Writeln Channel iProgChan "" Writeln Channel iProgChan " If (SEQEOF) Begin" Writeln Channel iProgChan " Close_Input Channel iFileChan" Writeln Channel iProgChan (' Send Stop_Box '+'"'+'Import file '+sFilePath+' not found!" "ERROR!"') Writeln Channel iProgChan " Procedure_Return" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" End_Procedure Procedure WriteConvertHexToAscii Writeln Channel iProgChan "" Writeln Channel iProgChan " Function ConvertHexToAscii String sField Returns String" Writeln Channel iProgChan " String sNewField" Writeln Channel iProgChan "" Writeln Channel iProgChan ' Direct_Output Channel iHexChan "Clipboard:"' Writeln Channel iProgChan " Writeln Channel iHexChan sField" Writeln Channel iProgChan " Close_Output Channel iHexChan" Writeln Channel iProgChan "" Writeln Channel iProgChan ' Direct_Input Channel iHexChan "Clipboard:"' Writeln Channel iProgChan " Read_Hex Channel iHexChan sNewField 0" Writeln Channel iProgChan " Close_Input Channel iHexChan" Writeln Channel iProgChan "" Writeln Channel iProgChan " Function_Return sNewField" Writeln Channel iProgChan " End_Function" Writeln Channel iProgChan "" End_Procedure //------------------------------------------------------------------------> // Delimited section //------------------------------------------------------------------------> Procedure Write_CSV_Code Integer iFile# String sRootName Integer iNumberOfFields String sFieldName ; Integer iIsAHeader Integer iZeroFile String sFilePath Integer iIndex Integer iReadHex Integer iField Integer iArrayItems Integer iArrayObj Integer iItem String sIndex String sFieldList String sQuote Move '"' To sQuote If (iIndex > 0) Move iIndex To sIndex Writeln Channel iProgChan " Object oImportData Is A BusinessProcess" Writeln Channel iProgChan "" Send Write_Error_Routine If (iReadHex); Send WriteConvertHexToAscii Writeln Channel iProgChan " Function Write_The_CSV Integer iFile# Integer iField Integer iImportDD String sInput Returns String" Writeln Channel iProgChan " Integer iFieldDataType" Writeln Channel iProgChan " Integer iDelimiterPos" Writeln Channel iProgChan " Integer iReadHex" Writeln Channel iProgChan " String sDelimiter" Writeln Channel iProgChan " String sField" Writeln Channel iProgChan " String sText" Writeln Channel iProgChan "" If (iReadHex); Writeln Channel iProgChan " Move 1 to iReadHex" Writeln Channel iProgChan "" Writeln Channel iProgChan (' Move "'+(psDelimiter(Self))+'" To sDelimiter') Writeln Channel iProgChan "" Writeln Channel iProgChan " get_Attribute DF_FIELD_TYPE of iFile# iField to iFieldDataType" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (iFieldDataType = DF_TEXT or iFieldDataType = DF_BINARY) ;" Writeln Channel iProgChan " Send DefineExtendedField to iImportDD iField" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (iFieldDataType <> DF_OVERLAP) Begin" Writeln Channel iProgChan "" Writeln Channel iProgChan " move (pos(sDelimiter, sInput)) to iDelimiterPos" Writeln Channel iProgChan " if (iDelimiterPos > 0) begin" Writeln Channel iProgChan " move (left(sInput,(iDelimiterPos - 1))) to sField" Writeln Channel iProgChan " move (right(sInput,(length(sInput) - iDelimiterPos))) to sInput" Writeln Channel iProgChan (" Move (Replaces('"+sQuote+"', sField, '')) to sField") Writeln Channel iProgChan "" If (iReadHex) Begin Writeln Channel iProgChan " // If set to read hex and we find that the data field is text or binary" Writeln Channel iProgChan " If (iReadHex and (iFieldDataType = DF_TEXT or iFieldDataType = DF_BINARY)) Begin" Writeln Channel iProgChan " Move (ConvertHexToAscii(Self, sField)) to sText" Writeln Channel iProgChan " Set Field_Changed_Value of iImportDD iField to sText" Writeln Channel iProgChan " End" Writeln Channel iProgChan " // Write it to the data file" Writeln Channel iProgChan " Else Set Field_Changed_Value of iImportDD iField to sField" End Else ; Writeln Channel iProgChan " Set Field_Changed_Value of iImportDD iField to sField" Writeln Channel iProgChan "" Writeln Channel iProgChan " Function_Return sInput" Writeln Channel iProgChan " End" Writeln Channel iProgChan " Else Begin" Writeln Channel iProgChan " // Last field" Writeln Channel iProgChan (" Move (Replaces('"+sQuote+"', sInput, '')) to sInput") If (iReadHex) Begin Writeln Channel iProgChan " If (iReadHex and (iFieldDataType = DF_TEXT or iFieldDataType = DF_BINARY)) Begin" Writeln Channel iProgChan " Move (ConvertHexToAscii(Self, sInput)) to sText" Writeln Channel iProgChan " Set Field_Changed_Value of iImportDD iField to sText" Writeln Channel iProgChan " End" Writeln Channel iProgChan " Else Set Field_Changed_Value of iImportDD iField to sInput" End Else ; Writeln Channel iProgChan " Set Field_Changed_Value of iImportDD iField to sField" Writeln Channel iProgChan ' Move "" to sInput' Writeln Channel iProgChan " End" Writeln Channel iProgChan " End" Writeln Channel iProgChan ' Function_Return ""' Writeln Channel iProgChan " End_Function" Writeln Channel iProgChan "" Writeln Channel iProgChan " Procedure OnProcess" Writeln Channel iProgChan "" Send Write_Variables Writeln Channel iProgChan "" Writeln Channel iProgChan " Move ';' to Semi$" Writeln Channel iProgChan "" Writeln Channel iProgChan " Move (Status_Panel(self)) to iStatPnl" Writeln Channel iProgChan "" Writeln Channel iProgChan (' Move '+String(iFile#)+' To iFile#') Writeln Channel iProgChan "" // Get the field numbers and write to a variable // so we can read them in the output program Move (oFieldArray(Self)) To iArrayObj Get Item_Count Of iArrayObj To iArrayItems If (iArrayItems > 0) Move (iArrayItems-1) To iNumberOfFields For iItem From 1 To iNumberOfFields Get Array_Value Of iArrayObj Item (iItem-1) To iField Move (Append(sFieldList, String(iField)+";")) To sFieldList Loop If (iArrayItems > 0) Begin Writeln Channel iProgChan ' // Only these fields are being read' Writeln Channel iProgChan (' Move "'+sFieldList+'" to sFieldList') Writeln Channel iProgChan " Move sFieldList to sOrigFieldList" End Else Begin Writeln Channel iProgChan ' // All fields are being read' Writeln Channel iProgChan ' Move "" to sFieldList' End Writeln Channel iProgChan "" If (iZeroFile); Send Write_Zerofile_Error_Trapping Else Begin Writeln Channel iProgChan ' Open iFile#' Writeln Channel iProgChan "" End If (iZeroFile ); Writeln Channel iProgChan ' Zerofile iFile#' Writeln Channel iProgChan "" Send DD_And_Open_File sFilePath Writeln Channel iProgChan "" Writeln Channel iProgChan (' Send Initialize_StatusPanel to iStatPnl ("Importing '+sRootName+'") "" ""') Writeln Channel iProgChan " Send Start_StatusPanel to iStatPnl" Writeln Channel iProgChan "" If (iIsAHeader) Begin Writeln Channel iProgChan "" Writeln Channel iProgChan " Readln Channel iFileChan // Bypass the header record" End Writeln Channel iProgChan "" Writeln Channel iProgChan " Repeat" Writeln Channel iProgChan "" Writeln Channel iProgChan " Send Clear to iImportDD" Writeln Channel iProgChan "" Writeln Channel iProgChan " ReadLn Channel iFileChan sInput" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (not(SEQEOF)) Begin" Writeln Channel iProgChan "" Writeln Channel iProgChan " // Import the selected list" Writeln Channel iProgChan ' If (sFieldList > "") Begin' Writeln Channel iProgChan " Repeat" Writeln Channel iProgChan " move (pos(Semi$, sFieldList)) to iSemi" Writeln Channel iProgChan " if (iSemi > 0) begin" Writeln Channel iProgChan " move ((left(sFieldList,(iSemi - 1)))) to iField" Writeln Channel iProgChan " If (iField > 0) Get Write_The_CSV iFile# iField iImportDD sInput to sInput" Writeln Channel iProgChan " move (right(sFieldList,(length(sFieldList) - iSemi))) to sFieldList" Writeln Channel iProgChan " End" Writeln Channel iProgChan " Else move 0 to iField" Writeln Channel iProgChan " Until (iField = 0)" Writeln Channel iProgChan "" Writeln Channel iProgChan " Move sOrigFieldList to sFieldList // start over" Writeln Channel iProgChan "" Writeln Channel iProgChan " End" Writeln Channel iProgChan " // Or, Import the whole record" Writeln Channel iProgChan " Else Begin" Writeln Channel iProgChan " For iField From 1 to iNumberOfFields" Writeln Channel iProgChan " If (iField > 0) Get Write_The_CSV iFile# iField iImportDD sInput to sInput" Writeln Channel iProgChan " Loop" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan " Get Request_Validate of iImportDD to bErr" Writeln Channel iProgChan " if not bErr Begin" Writeln Channel iProgChan " // Error redirection not used here, " Writeln Channel iProgChan " // but available for user augmentation" Writeln Channel iProgChan " Set piOldErrorId to Error_object_id" Writeln Channel iProgChan " Move (Self) to Error_Object_Id" Writeln Channel iProgChan " Send Request_Save to iImportDD" Writeln Channel iProgChan " Move (piOldErrorId(Self)) to Error_Object_Id" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan " Increment iCounter" Writeln Channel iProgChan "" Writeln Channel iProgChan ' Send Update_StatusPanel to iStatPnl ("Record:"+string(iCounter))' Writeln Channel iProgChan " Get Check_StatusPanel of iStatPnl to iUserCancel" Writeln Channel iProgChan " If (iUserCancel) Begin" Writeln Channel iProgChan " Send Stop_StatusPanel to iStatPnl" Writeln Channel iProgChan ' Get Yesno_Box "Do you want to stop the process?" to iRC' Writeln Channel iProgChan " If (iRC = MBR_Yes) Begin" Writeln Channel iProgChan " Close_Input Channel iFileChan" Writeln Channel iProgChan (' Send Info_Box (string(iCounter)+" Records have been imported.'+'")' ) Writeln Channel iProgChan " Function_Return" Writeln Channel iProgChan " End" Writeln Channel iProgChan " Else Send Start_StatusPanel to iStatPnl" Writeln Channel iProgChan " End" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan " Until (SEQEOF)" Writeln Channel iProgChan "" Writeln Channel iProgChan " Send Stop_StatusPanel to iStatPnl" Writeln Channel iProgChan "" Writeln Channel iProgChan " Close_Input Channel iFileChan" Writeln Channel iProgChan "" Writeln Channel iProgChan (' Send Info_Box (string(iCounter)+" Records have been imported.'+'")' ) Writeln Channel iProgChan "" Writeln Channel iProgChan " End_Procedure" Writeln Channel iProgChan "" Writeln Channel iProgChan " End_Object" End_Procedure //------------------------------------------------------------------------> // XML section //------------------------------------------------------------------------> Procedure Write_XML_Code Integer iFile# String sRootName String sFieldName ; Integer iIsAHeader Integer iZeroFile String sFilePath Integer iIndex Integer iReadHex Integer iField Integer iArrayItems Integer iArrayObj Integer iItem Integer iNumberOfFields String sIndex String sFieldList If (iIndex > 0) Move iIndex To sIndex Writeln Channel iProgChan " Object oImportData Is A BusinessProcess" Writeln Channel iProgChan "" Send Write_Error_Routine If (iReadHex); Send WriteConvertHexToAscii Writeln Channel iProgChan " Procedure Write_The_XML Integer iFile# Integer iField Handle hoRecord Integer iImportDD" Writeln Channel iProgChan " String sFieldName" Writeln Channel iProgChan " String sText" Writeln Channel iProgChan " String sInput" Writeln Channel iProgChan " Integer iFieldDataType" Writeln Channel iProgChan " Integer iReadHex" Writeln Channel iProgChan "" If (iReadHex); Writeln Channel iProgChan " Move 1 to iReadHex" Writeln Channel iProgChan "" Writeln Channel iProgChan " get_attribute DF_FIELD_NAME of iFile# iField to sFieldName" Writeln Channel iProgChan " get_Attribute DF_FIELD_TYPE of iFile# iField to iFieldDataType" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (iFieldDataType = DF_TEXT or iFieldDataType = DF_BINARY) ;" Writeln Channel iProgChan " Send DefineExtendedField to iImportDD iField" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (iFieldDataType <> DF_OVERLAP) Begin" Writeln Channel iProgChan " // Read the XML node" Writeln Channel iProgChan ' Move "" to sInput' Writeln Channel iProgChan " Get ChildNodeValue Of hoRecord (trim(sFieldName)) To sInput" Writeln Channel iProgChan "" If (iReadHex) Begin Writeln Channel iProgChan " // If set to read hex and we find that the data field is text or binary" Writeln Channel iProgChan " If (iReadHex and (iFieldDataType = DF_TEXT or iFieldDataType = DF_BINARY)) Begin" Writeln Channel iProgChan " Move (ConvertHexToAscii(Self, sInput)) to sText" Writeln Channel iProgChan " Set Field_Changed_Value of iImportDD iField to sText" Writeln Channel iProgChan " End" Writeln Channel iProgChan " // Write it to the data file" Writeln Channel iProgChan " Else Set Field_Changed_Value of iImportDD iField to sInput" End Else ; Writeln Channel iProgChan " Set Field_Changed_Value of iImportDD iField to sInput" Writeln Channel iProgChan "" Writeln Channel iProgChan " End" Writeln Channel iProgChan " End_Procedure" Writeln Channel iProgChan "" Writeln Channel iProgChan " Procedure OnProcess" Writeln Channel iProgChan "" Send Write_Variables Writeln Channel iProgChan "" Writeln Channel iProgChan " Move (Status_Panel(self)) to iStatPnl" Writeln Channel iProgChan "" Writeln Channel iProgChan (' Move '+String(iFile#)+' To iFile#') Writeln Channel iProgChan "" Writeln Channel iProgChan ' Move ";" to Semi$' Writeln Channel iProgChan "" // Get the field numbers and write to a variable // so we can read them in the output program Move (oFieldArray(Self)) To iArrayObj Get Item_Count Of iArrayObj To iArrayItems If (iArrayItems > 0) Move (iArrayItems-1) To iNumberOfFields For iItem From 1 To iNumberOfFields Get Array_Value Of iArrayObj Item (iItem-1) To iField Move (Append(sFieldList, String(iField)+";")) To sFieldList Loop If (iArrayItems > 0) Begin Writeln Channel iProgChan ' // Only these fields are being read' Writeln Channel iProgChan (' Move "'+sFieldList+'" to sFieldList') Writeln Channel iProgChan " Move sFieldList to sOrigFieldList" End Else Begin Writeln Channel iProgChan ' // All fields are being read' Writeln Channel iProgChan ' Move "" to sFieldList' End Writeln Channel iProgChan "" If (iZeroFile); Send Write_Zerofile_Error_Trapping Else Begin Writeln Channel iProgChan ' Open iFile#' Writeln Channel iProgChan "" End If (iZeroFile ); Writeln Channel iProgChan ' Zerofile iFile#' Writeln Channel iProgChan "" Send DD_And_Open_File sFilePath Writeln Channel iProgChan "" Writeln Channel iProgChan " Close_Input Channel iFileChan" Writeln Channel iProgChan "" Writeln Channel iProgChan (' Send Initialize_StatusPanel to iStatPnl ("Importing '+sRootName+'") "" ""') Writeln Channel iProgChan " Send Start_StatusPanel to iStatPnl" Writeln Channel iProgChan "" Writeln Channel iProgChan " Get Create U_cXMLDOMDocument To hoXML" Writeln Channel iProgChan "" Writeln Channel iProgChan (' Set psDocumentName Of hoXML To '+'"'+sFilePath+'"') Writeln Channel iProgChan " Set pbValidateOnParse Of hoXML To True" Writeln Channel iProgChan " Get LoadXMLDocument Of hoXML To bOK" Writeln Channel iProgChan "" Writeln Channel iProgChan " If Not bOK Begin" Writeln Channel iProgChan ' Send Stop_Box "XML Loading Error!"' Writeln Channel iProgChan " End" Writeln Channel iProgChan " Else Begin" Writeln Channel iProgChan " Get DocumentElement Of hoXML To hoRoot" Writeln Channel iProgChan " // create a collection node of all customers" Writeln Channel iProgChan ' Get FindNodeList Of hoRoot "Row" To hoList' Writeln Channel iProgChan " Get NodeListLength Of hoList To iItems" Writeln Channel iProgChan " Decrement iItems" Writeln Channel iProgChan "" Writeln Channel iProgChan " // This is actually the number of records being imported" Writeln Channel iProgChan " For iCounter From 0 To iItems" Writeln Channel iProgChan " Get CollectionNode Of hoList iCounter To hoRecord" Writeln Channel iProgChan "" Writeln Channel iProgChan " Send Clear to iImportDD" Writeln Channel iProgChan "" Writeln Channel iProgChan " // Import the selected list" Writeln Channel iProgChan ' If (sFieldList > "") Begin' Writeln Channel iProgChan " Repeat" Writeln Channel iProgChan " move (pos(Semi$, sFieldList)) to iSemi" Writeln Channel iProgChan " if (iSemi > 0) begin" Writeln Channel iProgChan " move ((left(sFieldList,(iSemi - 1)))) to iField" Writeln Channel iProgChan " If (iField > 0) Send Write_The_XML iFile# iField hoRecord iImportDD" Writeln Channel iProgChan " move (right(sFieldList,(length(sFieldList) - iSemi))) to sFieldList" Writeln Channel iProgChan " End" Writeln Channel iProgChan " Else move 0 to iField" Writeln Channel iProgChan " Until (iField = 0)" Writeln Channel iProgChan "" Writeln Channel iProgChan " Move sOrigFieldList to sFieldList // start over" Writeln Channel iProgChan "" Writeln Channel iProgChan " End" Writeln Channel iProgChan " // Or, Import the whole record" Writeln Channel iProgChan " Else Begin" Writeln Channel iProgChan " For iField From 1 to iNumberOfFields" Writeln Channel iProgChan " Send Write_The_XML iFile# iField hoRecord iImportDD" Writeln Channel iProgChan " Loop" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan " Send Destroy Of hoRecord" Writeln Channel iProgChan "" Writeln Channel iProgChan " Get Request_Validate of iImportDD to bErr" Writeln Channel iProgChan " if not bErr Begin" Writeln Channel iProgChan " // Error redirection not used here, " Writeln Channel iProgChan " // but available for user augmentation" Writeln Channel iProgChan " Set piOldErrorId to Error_object_id" Writeln Channel iProgChan " Move (Self) to Error_Object_Id" Writeln Channel iProgChan " Send Request_Save to iImportDD" Writeln Channel iProgChan " Move (piOldErrorId(Self)) to Error_Object_Id" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan ' Send Update_StatusPanel to iStatPnl ("Record:"+string(iCounter))' Writeln Channel iProgChan " Get Check_StatusPanel of iStatPnl to iUserCancel" Writeln Channel iProgChan " If (iUserCancel) Begin" Writeln Channel iProgChan " Send Stop_StatusPanel to iStatPnl" Writeln Channel iProgChan ' Get Yesno_Box "Do you want to stop the process?" to iRC' Writeln Channel iProgChan " If (iRC = MBR_Yes) Begin" Writeln Channel iProgChan " Close_Input Channel iFileChan" Writeln Channel iProgChan (' Send Info_Box (string(iCounter)+" Records have been imported.'+'")' ) Writeln Channel iProgChan " Function_Return" Writeln Channel iProgChan " End" Writeln Channel iProgChan " Else Send Start_StatusPanel to iStatPnl" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan " Loop" Writeln Channel iProgChan "" Writeln Channel iProgChan " Send Destroy To hoList" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan " Send Destroy Of hoXML" Writeln Channel iProgChan "" Writeln Channel iProgChan " Send Stop_StatusPanel to iStatPnl" Writeln Channel iProgChan "" Writeln Channel iProgChan (' Send Info_Box (string(iCounter)+" Records have been imported.'+'")' ) Writeln Channel iProgChan "" Writeln Channel iProgChan " End_Procedure" Writeln Channel iProgChan "" Writeln Channel iProgChan " End_Object" End_Procedure //------------------------------------------------------------------------> // Fixed Field Length section //------------------------------------------------------------------------> Procedure Write_FFL_Code Integer iFile# String sRootName Integer iNumberOfFields String sFieldName ; Integer iIsAHeader Integer iZeroFile String sFilePath Integer iIndex Integer iReadHex Integer iField Integer iArrayItems Integer iArrayObj Integer iItem String sIndex String sFieldList If (iIndex > 0) Move iIndex To sIndex Writeln Channel iProgChan " Object oImportData Is A BusinessProcess" Writeln Channel iProgChan "" Send Write_Error_Routine If (iReadHex); Send WriteConvertHexToAscii Writeln Channel iProgChan " Function Write_The_FFL Integer iFile# Integer iField Integer iFieldStart Integer iImportDD String sInput Returns Integer" Writeln Channel iProgChan " String sField" Writeln Channel iProgChan " String sText" Writeln Channel iProgChan " Integer iFieldDataType" Writeln Channel iProgChan " Integer iFieldLength" Writeln Channel iProgChan " Integer iReadHex" Writeln Channel iProgChan "" If (iReadHex); Writeln Channel iProgChan " Move 1 to iReadHex" Writeln Channel iProgChan "" Writeln Channel iProgChan " get_attribute DF_FIELD_LENGTH of iFile# iField to iFieldLength" Writeln Channel iProgChan " get_Attribute DF_FIELD_TYPE of iFile# iField to iFieldDataType" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (iFieldDataType = DF_TEXT or iFieldDataType = DF_BINARY) ;" Writeln Channel iProgChan " Send DefineExtendedField to iImportDD iField" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (iFieldDataType <> DF_OVERLAP) Begin" Writeln Channel iProgChan "" Writeln Channel iProgChan " Move (Mid(sInput, iFieldLength, iFieldStart)) to sField" Writeln Channel iProgChan "" If (iReadHex) Begin Writeln Channel iProgChan " // If set to read hex and we find that the data field is text or binary" Writeln Channel iProgChan " If (iReadHex and (iFieldDataType = DF_TEXT or iFieldDataType = DF_BINARY)) Begin" Writeln Channel iProgChan " Move (ConvertHexToAscii(Self, sField)) to sText" Writeln Channel iProgChan " Set Field_Changed_Value of iImportDD iField to sText" Writeln Channel iProgChan " End" Writeln Channel iProgChan " // Write it to the data file" Writeln Channel iProgChan " Else Set Field_Changed_Value of iImportDD iField to (trim(sField))" End Else ; Writeln Channel iProgChan " Set Field_Changed_Value of iImportDD iField to sField" Writeln Channel iProgChan "" Writeln Channel iProgChan " // Each field starts at the end of the previous one" Writeln Channel iProgChan " Move (iFieldLength+iFieldStart) to iFieldStart" Writeln Channel iProgChan "" Writeln Channel iProgChan " Function_Return iFieldStart" Writeln Channel iProgChan " End" Writeln Channel iProgChan " End_Function" Writeln Channel iProgChan "" Writeln Channel iProgChan " Procedure OnProcess" Writeln Channel iProgChan "" Send Write_Variables Writeln Channel iProgChan "" Writeln Channel iProgChan " Move (Status_Panel(self)) to iStatPnl" Writeln Channel iProgChan "" Writeln Channel iProgChan (' Move '+String(iFile#)+' To iFile#') Writeln Channel iProgChan "" Writeln Channel iProgChan ' Move ";" to Semi$' Writeln Channel iProgChan "" // Get the field numbers and write to a variable // so we can read them in the output program Move (oFieldArray(Self)) To iArrayObj Get Item_Count Of iArrayObj To iArrayItems If (iArrayItems > 0) Move (iArrayItems-1) To iNumberOfFields For iItem From 1 To iNumberOfFields Get Array_Value Of iArrayObj Item (iItem-1) To iField Move (Append(sFieldList, String(iField)+";")) To sFieldList Loop If (iArrayItems > 0) Begin Writeln Channel iProgChan ' // Only these fields being read' Writeln Channel iProgChan (' Move "'+sFieldList+'" to sFieldList') Writeln Channel iProgChan " Move sFieldList to sOrigFieldList" End Else Begin Writeln Channel iProgChan ' // All fields being read' Writeln Channel iProgChan ' Move "" to sFieldList' End Writeln Channel iProgChan "" If (iZeroFile); Send Write_Zerofile_Error_Trapping Else Begin Writeln Channel iProgChan ' Open iFile#' Writeln Channel iProgChan "" End If (iZeroFile ); Writeln Channel iProgChan ' Zerofile iFile#' Writeln Channel iProgChan "" Send DD_And_Open_File sFilePath Writeln Channel iProgChan (' Send Initialize_StatusPanel to iStatPnl ("Importing '+sRootName+'") "" ""') Writeln Channel iProgChan " Send Start_StatusPanel to iStatPnl" Writeln Channel iProgChan "" If (iIsAHeader) Begin Writeln Channel iProgChan "" Writeln Channel iProgChan " Readln Channel iFileChan // Bypass the header record" End Writeln Channel iProgChan "" Writeln Channel iProgChan " Repeat" Writeln Channel iProgChan "" Writeln Channel iProgChan " Send Clear to iImportDD" Writeln Channel iProgChan "" Writeln Channel iProgChan " Move 1 to iFieldStart" Writeln Channel iProgChan "" Writeln Channel iProgChan " Readln Channel iFileChan sInput" Writeln Channel iProgChan "" Writeln Channel iProgChan " If (not(SEQEOF)) Begin" Writeln Channel iProgChan "" Writeln Channel iProgChan " // Import the selected list" Writeln Channel iProgChan ' If (sFieldList > "") Begin' Writeln Channel iProgChan " Repeat" Writeln Channel iProgChan " move (pos(Semi$, sFieldList)) to iSemi" Writeln Channel iProgChan " if (iSemi > 0) begin" Writeln Channel iProgChan " move ((left(sFieldList,(iSemi - 1)))) to iField" Writeln Channel iProgChan " If (iField > 0) Get Write_The_FFL iFile# iField iFieldStart iImportDD sInput to iFieldStart" Writeln Channel iProgChan " move (right(sFieldList,(length(sFieldList) - iSemi))) to sFieldList" Writeln Channel iProgChan " End" Writeln Channel iProgChan " Else move 0 to iField" Writeln Channel iProgChan " Until (iField = 0)" Writeln Channel iProgChan "" Writeln Channel iProgChan " Move sOrigFieldList to sFieldList // start over" Writeln Channel iProgChan "" Writeln Channel iProgChan " End" Writeln Channel iProgChan " // Or, Import the whole record" Writeln Channel iProgChan " Else Begin" Writeln Channel iProgChan " For iField From 1 to iNumberOfFields" Writeln Channel iProgChan " If (iField > 0) Get Write_The_FFL iFile# iField iFieldStart iImportDD sInput to iFieldStart" Writeln Channel iProgChan " Loop" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan " Get Request_Validate of iImportDD to bErr" Writeln Channel iProgChan " if not bErr Begin" Writeln Channel iProgChan " // Error redirection not used here, " Writeln Channel iProgChan " // but available for user augmentation" Writeln Channel iProgChan " Set piOldErrorId to Error_object_id" Writeln Channel iProgChan " Move (Self) to Error_Object_Id" Writeln Channel iProgChan " Send Request_Save to iImportDD" Writeln Channel iProgChan " Move (piOldErrorId(Self)) to Error_Object_Id" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan " Increment iCounter" Writeln Channel iProgChan "" Writeln Channel iProgChan ' Send Update_StatusPanel to iStatPnl ("Record:"+string(iCounter))' Writeln Channel iProgChan " Get Check_StatusPanel of iStatPnl to iUserCancel" Writeln Channel iProgChan " If (iUserCancel) Begin" Writeln Channel iProgChan " Send Stop_StatusPanel to iStatPnl" Writeln Channel iProgChan ' Get Yesno_Box "Do you want to stop the process?" to iRC' Writeln Channel iProgChan " If (iRC = MBR_Yes) Begin" Writeln Channel iProgChan " Close_Input Channel iFileChan" Writeln Channel iProgChan (' Send Info_Box (string(iCounter)+" Records have been imported.'+'")' ) Writeln Channel iProgChan " Function_Return" Writeln Channel iProgChan " End" Writeln Channel iProgChan " Else Send Start_StatusPanel to iStatPnl" Writeln Channel iProgChan " End" Writeln Channel iProgChan " End" Writeln Channel iProgChan "" Writeln Channel iProgChan " Until (SEQEOF)" Writeln Channel iProgChan "" Writeln Channel iProgChan " Send Stop_StatusPanel to iStatPnl" Writeln Channel iProgChan "" Writeln Channel iProgChan " Close_Input Channel iFileChan" Writeln Channel iProgChan "" Writeln Channel iProgChan (' Send Info_Box (string(iCounter)+" Records have been imported.'+'")' ) Writeln Channel iProgChan "" Writeln Channel iProgChan " End_Procedure" Writeln Channel iProgChan "" Writeln Channel iProgChan " End_Object" End_Procedure //AB-StoreEnd End_Class // cDBImport Object oDBImport Is A cDbImport End_Object