{{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_StrDataSet.pas This unit contains the following routines.
ConvStrDatasetToStrTable_1 ConvStrDatasetToStrTable_2 ConvStrTableToTextTable_1 ConvStrTableToTextTable_2 ConvTDataSetToStrTable_1 ConvTDataSetToStrTable_2 ConvTDataSetToTextTable_ads_1 ConvTDataSetToTextTable_ads_2 ConvTDataSetToTextTable_ads_3 ConvTDataSetToTextTable_ads_4 RaiseError SaveToFile StrDataSetColDeleteByName_1 StrDataSetColDeleteByName_2 StrDataSetColDeleteByNumber_1 StrDataSetColDeleteByNumber_2 StrDataSetColGetCount_1 StrDataSetColGetCount_2 StrDataSetColGetNameByNumber_1 StrDataSetColGetNameByNumber_2 StrDataSetColGetNames_1 StrDataSetColGetNames_2 StrDataSetColGetNumberByName_1 StrDataSetColGetNumberByName_2 StrDataSetToGrid_1 StrDataSetToGrid_2 StrDBGetTableDataSet_1 StrDBGetTableDataSet_2 StrDBGetTableFieldCount_1 StrDBGetTableFieldCount_2 StrDBGetTableFieldNameByNumber_1 StrDBGetTableFieldNameByNumber_2 StrDBGetTableFieldNumber_1 StrDBGetTableFieldNumber_2 StrDBGetTableFields_1 StrDBGetTableFields_2 StrDBGetTableRecordCount_1 StrDBGetTableRecordCount_2 StrRecordColDeleteByNumber_1 StrRecordColDeleteByNumber_2 StrTableColDeleteByName_1 StrTableColDeleteByName_2 StrTableColDeleteByNumber_1 StrTableColDeleteByNumber_2 StrTableGetTableName_1 StrTableGetTableName_2 StrTableMakeTableFooter_1 StrTableMakeTableFooter_2 StrTableMakeTableHeader_1 StrTableMakeTableHeader_2 TextTableChangesToNewTable_1 TextTableChangesToNewTable_2 TextTableChangesToNewTable_3 TextTableChangesToNewTable_4 TextTableFieldAddAToB_1 TextTableFieldAddAToB_2 TextTableFieldAddTextAfter_1 TextTableFieldAddTextAfter_2 TextTableFieldAddTextBefore_1 TextTableFieldAddTextBefore_2 TextTableFieldAppend_1 TextTableFieldAppend_2 TextTableFieldChangeNameByName_1 TextTableFieldChangeNameByName_2 TextTableFieldChangeNameByName_3 TextTableFieldChangeNameByName_4 TextTableFieldChangeNameByNumber_1 TextTableFieldChangeNameByNumber_2 TextTableFieldCopyAToB_1 TextTableFieldCopyAToB_2 TextTableFieldCopyAToB_3 TextTableFieldCopyAToB_4 TextTableFieldCount_1 TextTableFieldCount_2 TextTableFieldDateYYYYMMDDToMMDDYYYY_1 TextTableFieldDateYYYYMMDDToMMDDYYYY_2 TextTableFieldDecimalsFromNumber_1 TextTableFieldDecimalsFromNumber_2 TextTableFieldDeleteByName_1 TextTableFieldDeleteByName_2 TextTableFieldDeleteByNumber_1 TextTableFieldDeleteByNumber_2 TextTableFieldDeleteByNumber_3 TextTableFieldDeleteByNumber_4 TextTableFieldInsert_1 TextTableFieldInsert_2 TextTableFieldInsert_3 TextTableFieldInsert_4 TextTableFieldLengthFromNumber_1 TextTableFieldLengthFromNumber_2 TextTableFieldMoveByNumber_1 TextTableFieldMoveByNumber_2 TextTableFieldNameFromNumber_1 TextTableFieldNameFromNumber_2 TextTableFieldNumberFromName_1 TextTableFieldNumberFromName_2 TextTableFieldNumberFromName_3 TextTableFieldNumberFromName_4 TextTableFieldPad_1 TextTableFieldPad_2 TextTableFieldStartsRefresh_1 TextTableFieldStartsRefresh_2 TextTableFieldTrim_1 TextTableFieldTrim_2 TextTableFieldTypeFromName_1 TextTableFieldTypeFromName_2 TextTableFieldTypeFromNumber_1 TextTableFieldTypeFromNumber_2 TextTableFieldUpdate_1 TextTableFieldUpdate_2 TextTableFieldUpdate_3 TextTableFieldUpdate_4 TextTableFieldUpdate_5 TextTableFieldUpdate_6 TextTableFieldUpdate_7 TextTableFileWrite_1 TextTableFileWrite_2 TextTableGetRecordNumber_1 TextTableGetRecordNumber_2 TextTableLookupGetValueFromKey_1 TextTableLookupGetValueFromKey_2 TextTableLookupGetValueFromKey_3 TextTableLookupGetValueFromKey_4 TextTableLookupGetValueFromKey_5 TextTableLookupGetValueFromKey_6 TextTableLookupGetValueFromRecNo_1 TextTableLookupGetValueFromRecNo_2 TextTableLookupGetValueFromRecNo_3 TextTableLookupGetValueFromRecNo_4 TextTableLookupKeyToValues_1 TextTableLookupKeyToValues_2 TextTableLookupToList_1 TextTableLookupToList_2 TextTablePopulate_1 TextTablePopulate_2 TextTablePopulate_3 TextTablePopulate_4 TextTableRecordCopy_1 TextTableRecordCopy_2 TextTableRecordDeleteByNumber_1 TextTableRecordDeleteByNumber_2 TextTableToClientDataset_1 TextTableToClientDataset_2 TextTableToGrid_1 TextTableToGrid_2 TextTableToGrid_3 TextTableToGrid_4
*) //Advanced Delphi Systems Code: ads_StrDataSet unit ads_StrDataSet; {Copyright(c)2016 Advanced Delphi Systems Richard Maley Advanced Delphi Systems 12613 Maidens Bower Drive Potomac, MD 20854 USA phone 301-840-1554 dickmaley@advdelphisys.com The code herein can be used or modified by anyone. Please retain references to Richard Maley at Advanced Delphi Systems. If you make improvements to the code please send your improvements to dickmaley@advdelphisys.com so that the entire Delphi community can benefit. All comments are welcome. } (*UnitIndex Master Index implementation Section Download UnitsDescription: ads_StrDataSet.pas This unit contains routines for manipulating Text Tables (standard text table used in Delphi) and StrTables (String Datasets). Definitions for a StrTable: Purpose : Provides the ability to pass large datasets across diverse language boundaries such as OLE, CORBA, and JAVA as strings. The string structure is very compact and fast. StrDB : A String Database. Contains StrTables's. StrTable : A String Table. Contains, a Header, a StrDataset and a Footer. StrDataset: A delimited data array with the first record defining column labels. The implementation section of this unit defines the following constants: Tag_Table_Start_Before = #12; Tag_Table_Start_After = #13#10; Tag_Table_End_Before = #13#10; Tag_Table_End_After = #13#10#13#10; Tag_Table_End_IncName = False; Tag_FieldSeparator = #9; Tag_RecordSeparator = #13#10; These constants establish how fields, records and tables start and end. From the second record to the last record is all the data in the dataset. StrRecord: A String Record.Constants ConvStrDatasetToStrTable ConvStrTableToTextTable ConvTDataSetToStrTable ConvTDataSetToTextTable_ads StrDBGetTableDataSet StrDBGetTableFieldCount StrDBGetTableFieldNameByNumber StrDBGetTableFieldNumber StrDBGetTableFields StrDBGetTableRecordCount RaiseError SaveToFile StrDataSetColDeleteByName StrDataSetColDeleteByNumber StrDataSetColGetCount StrDataSetColGetNameByNumber StrDataSetColGetNames StrDataSetColGetNumberByName StrDataSetToGrid StrRecordColDeleteByNumber StrTableColDeleteByName StrTableColDeleteByNumber StrTableGetTableName StrTableMakeTableFooter StrTableMakeTableHeader TextTableChangesToNewTable_OverLoaded1 TextTableChangesToNewTable_OverLoaded2 TextTableFieldAddAToB TextTableFieldAddTextAfter TextTableFieldAddTextBefore TextTableFieldAppend TextTableFieldChangeNameByName_OverLoaded1 TextTableFieldChangeNameByName_OverLoaded2 TextTableFieldChangeNameByNumber TextTableFieldCopyAToB_OverLoaded1 TextTableFieldCopyAToB_OverLoaded2 TextTableFieldCount TextTableFieldDateYYYYMMDDToMMDDYYYY TextTableFieldDecimalsFromNumber TextTableFieldDeleteByName TextTableFieldDeleteByNumber_OverLoaded1 TextTableFieldDeleteByNumber_OverLoaded2 TextTableFieldInsert_OverLoaded1 TextTableFieldInsert_OverLoaded2 TextTableFieldLengthFromNumber TextTableFieldMoveByNumber TextTableFieldNameFromNumber TextTableFieldNumberFromName_OverLoaded1 TextTableFieldNumberFromName_OverLoaded2 TextTableFieldPad TextTableFieldStartsRefresh TextTableFieldTrim TextTableFieldTypeFromName TextTableFieldTypeFromNumber TextTableFieldUpdate_OverLoaded1 TextTableFieldUpdate_OverLoaded2 TextTableFieldUpdate_OverLoaded3 TextTableFieldUpdate_OverLoaded4 TextTableFileWrite TextTableGetRecordNumber TextTableLookupGetValueFromKey_OverLoaded1 TextTableLookupGetValueFromKey_OverLoaded2 TextTableLookupGetValueFromKey_OverLoaded3 TextTableLookupGetValueFromRecNo_OverLoaded1 TextTableLookupGetValueFromRecNo_OverLoaded2 TextTableLookupKeyToValues TextTableLookupToList TextTablePopulate TextTableRecordCopy TextTableRecordDeleteByNumber TextTableToGrid_OverLoaded1 TextTableToGrid_OverLoaded2 TTextTable_ads
*) interface Uses SysUtils, DB, Classes, Grids, Windows, dbClient; //Unit Description UnitIndex Master IndexType TTextTable_ads = record DBName : String; TableName : String; arFldData : Array of Array of String; arFldLen : Array of Integer; arFldNames : Array of String; arFldPrec : Array of Integer; arFldStrt : Array of Integer; arFldTypes : Array of String; inRowCount : Integer; inFldCount : Integer; end; //Unit Description UnitIndex Master IndexFunction ConvStrTableToTextTable(StrTable,StrTableName,TextDBName,TextTableName:String;KeepSchema:Boolean): Boolean; //Unit Description UnitIndex Master IndexFunction ConvTDataSetToTextTable_ads(DataSet:TDataSet;TextDatabaseName,TextTableName:String): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction ConvTDataSetToTextTable_ads(DataSet:TDataSet;TableName: String;out TextTableSchema,TextTableData:String): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction ConvStrDatasetToStrTable(TableName, StrDataSet : String): String; //Return: StrTable //Unit Description UnitIndex Master IndexFunction ConvTDataSetToStrTable(TableName : String; DataSet : TDataSet): String; //Return: StrTable //Unit Description UnitIndex Master IndexFunction StrDBGetTableDataSet(DBString, TableName : String): String; //Return: StrDataset //Unit Description UnitIndex Master IndexFunction StrDBGetTableFieldCount(DBString, TableName : String): Integer; //Return: Field Count //Unit Description UnitIndex Master IndexFunction StrDBGetTableFieldNameByNumber(DBString, TableName: String; FieldNumber : Integer): String;//Return: Field Name //Unit Description UnitIndex Master IndexFunction StrDBGetTableFieldNumber(DBString, TableName, FieldName : String): Integer; //Return: Field Number //Unit Description UnitIndex Master IndexFunction StrDBGetTableFields(DBString, TableName : String): String; //Return: Field list //Unit Description UnitIndex Master IndexFunction StrDBGetTableRecordCount(DBString, TableName : String): Integer; //Return: Record Count //Unit Description UnitIndex Master IndexFunction StrDataSetColDeleteByName(StrDataSet, FieldName:String): String; //Return: StrDataset //Unit Description UnitIndex Master IndexFunction StrDataSetColDeleteByNumber(StrDataSet:String;ColNum:Integer): String; //Return: StrDataset //Unit Description UnitIndex Master IndexFunction StrDataSetColGetCount(StrDataSet : String): Integer; //Return: Field Count //Unit Description UnitIndex Master IndexFunction StrDataSetColGetNameByNumber(StrDataSet: String;FieldNumber: Integer ): String;//Return: Field Name //Unit Description UnitIndex Master IndexFunction StrDataSetColGetNames(StrDataSet : String): String; //Return: Field list //Unit Description UnitIndex Master IndexFunction StrDataSetColGetNumberByName(StrDataSet,FieldName : String): Integer; //Return: Field Number //Unit Description UnitIndex Master IndexFunction StrDataSetToGrid(StrDataSet:String;Grid:TStringGrid;InsertGetCol:Boolean;SetGetColYes:Boolean):Boolean; //Unit Description UnitIndex Master IndexFunction StrRecordColDeleteByNumber(StrRecord:String;ColNum:Integer): String; //Return: StrRecord //Unit Description UnitIndex Master IndexFunction StrTableColDeleteByName(StrDataSet, FieldName:String): String; //Return: StrTable //Unit Description UnitIndex Master IndexFunction StrTableColDeleteByNumber(StrDataSet:String;ColNum:Integer): String; //Return: StrTable //Unit Description UnitIndex Master IndexFunction StrTableGetTableName(StrDataSet:String): String; //Return: StrTable Table Name //Unit Description UnitIndex Master IndexFunction StrTableMakeTableFooter(TableName:String): String; //Return: StrTable Footer //Unit Description UnitIndex Master IndexFunction StrTableMakeTableHeader(TableName:String): String; //Return: StrTable Header //Unit Description UnitIndex Master IndexFunction TextTableRecordDeleteByNumber( Var T : TTextTable_ads; RowNumber : Integer; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableRecordCopy( Var FromTable : TTextTable_ads; Var ToTable : TTextTable_ads; FromRowNumber : Integer; ToRowNumber : Integer; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableChangesToNewTable( BeforeDBName : String; BeforeTableName : String; AfterDBName : String; AfterTableName : String; ChangedDBName : String; ChangedTableName : String): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableChangesToNewTable( Var Before : TTextTable_ads; Var After : TTextTable_ads; Var Changed : TTextTable_ads; WriteToFile : Boolean): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableGetRecordNumber( Var T : TTextTable_ads; FieldNumber : Integer; FieldValue : String; CaseSensitive : Boolean; WriteToFile : Boolean): Integer; //Unit Description UnitIndex Master IndexFunction TextTableFieldPad( Var T : TTextTable_ads; FieldNumber : Integer; FillChar : String; StrLen : Integer; LeftJustify : Boolean; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableFieldTrim( Var T : TTextTable_ads; FieldNumber : Integer; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableLookupKeyToValues( Var T : TTextTable_ads; //Table to be modified Var L : TTextTable_ads; //lookup table TKeyFieldNumber : Integer; //Key Field in table to be modified LKeyFieldNumber : Integer; //Key Field in lookup table TValueFieldNumber: Integer; //Field to be modified LValueFieldNumber: Integer; //Lookup Field to add to Table WriteToFile : Boolean): Boolean;//Write to disk when done //Unit Description UnitIndex Master IndexFunction TextTableLookupGetValueFromKey( DBName : String; //Path to TextTables TableName : String; //TextTable Name no Extension LookupFieldName : String; //Lookup Field Name LookupFieldValue : String; //Lookup Field Value in lookup table ReturnFieldName : String) //Field Name for value returned :String;OverLoad; //A String is returned //Unit Description UnitIndex Master IndexFunction TextTableLookupGetValueFromRecNo( DBName : String; //Path to TextTables TableName : String; //TextTable Name no Extension RecNo : Integer;//Record Number ReturnFieldName : String) //Field Name for value returned :String; OverLoad; //A String is returned //Unit Description UnitIndex Master IndexFunction TextTableLookupGetValueFromRecNo( T : TTextTable_ads; //lookup table RecNo : Integer; //Record Number ReturnFieldNumber: Integer) //Field Number for value returned :String; OverLoad; //A String is returned //Unit Description UnitIndex Master IndexFunction TextTableLookupGetValueFromKey( T : TTextTable_ads; //lookup table LookupFieldNumber : Integer; //Key Field in lookup table LookupFieldValue : String; //Key Field Value in lookup table ReturnFieldNumber : Integer):String;OverLoad; //Field Number for value returned //Unit Description UnitIndex Master IndexFunction TextTableLookupGetValueFromKey( T : TTextTable_ads; //lookup table LookupFieldNumber1: Integer; //Key Field in lookup table LookupFieldValue1 : String; //Key Field Value in lookup table LookupFieldNumber2: Integer; //Key Field in lookup table LookupFieldValue2 : String; //Key Field Value in lookup table ReturnFieldNumber : Integer):String;OverLoad; //Field Number for value returned //Unit Description UnitIndex Master IndexFunction TextTableLookupToList( T : TTextTable_ads; //lookup table LookupFieldNumber : Integer; //Field used to populate TStrings lst : TStrings):Boolean; //TStrings list //Unit Description UnitIndex Master IndexFunction TextTableFieldChangeNameByName( DBName,TableName,OldFldName,NewFldName:String): Boolean;OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldChangeNameByName( Var T: TTextTable_ads;OldFldName,NewFldName:String; WriteToFile:Boolean): Boolean;OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableToGrid(Var T:TTextTable_ads;Grid:TStringGrid): Boolean;OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableToGrid(DBName,TableName:String;Grid:TStringGrid): Boolean;OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldChangeNameByNumber(DBName,TableName,NewFldName:String;FldNumber: Integer): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableFieldInsert( DBName, TableName, NewFldName, NewFldType: String; NewFldLength, NewFldDecimals, NewFldNumber: Integer): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldInsert( Var T : TTextTable_ads; NewFldName : String; NewFldType : String; NewFldLength : Integer; NewFldDecimals : Integer; NewFldNumber : Integer; WriteToFile : Boolean): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldCount( DBName, TableName: String): Integer; //Unit Description UnitIndex Master IndexFunction TextTableFieldTypeFromNumber( DBName, TableName: String; FieldNumber: Integer): String; //Unit Description UnitIndex Master IndexFunction TextTableFieldLengthFromNumber( DBName, TableName: String; FieldNumber: Integer): Integer; //Unit Description UnitIndex Master IndexFunction TextTableFileWrite(Var T: TTextTable_ads): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableFieldDecimalsFromNumber( DBName, TableName: String; FieldNumber: Integer): Integer; //Unit Description UnitIndex Master IndexFunction TextTableFieldCopyAToB( DBName, TableName: String; FromFieldNumber, ToFieldNumber:Integer): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldCopyAToB( Var T : TTextTable_ads; FromFieldNumber, ToFieldNumber:Integer): Boolean;OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldMoveByNumber( DBName, TableName: String; FromFieldNumber, ToFieldNumber:Integer): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableFieldTypeFromName( DBName, TableName, FieldName: String): String; //Unit Description UnitIndex Master IndexFunction TextTableFieldAppend( DBName, TableName, NewFldName, NewFldType: String; NewFldLength, NewFldDecimals: Integer): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableFieldDeleteByName( DBName, TableName, FieldName: String): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableFieldDeleteByNumber( DBName, TableName: String; FieldNumber: Integer): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldDeleteByNumber( Var T : TTextTable_ads; FieldNumber : Integer; WriteToFile : Boolean): Boolean;OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldDateYYYYMMDDToMMDDYYYY( Var T : TTextTable_ads; FieldNumber : Integer; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableFieldNumberFromName( DBName, TableName, FieldName: String): Integer;OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldNumberFromName( Var T : TTextTable_ads; FieldName: String): Integer; OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldNameFromNumber( DBName, TableName: String; FieldNumber: Integer): String; //Unit Description UnitIndex Master IndexFunction TextTablePopulate(Var T: TTextTable_ads): Boolean; Overload; //Unit Description UnitIndex Master IndexFunction TextTablePopulate( Var T : TTextTable_ads; TextTableSchema : String; TextTableData : String): Boolean; Overload; //Unit Description UnitIndex Master IndexFunction TextTableFieldStartsRefresh(Var T: TTextTable_ads;WriteToFile:Boolean): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableFieldAddTextBefore( Var T : TTextTable_ads; FieldNumber : Integer; Text : String; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableFieldAddTextAfter( Var T : TTextTable_ads; FieldNumber : Integer; Text : String; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableFieldUpdate( Var T : TTextTable_ads; FieldNumber : Integer; FieldValue : String; WhereFieldNumber : Integer; WhereFieldValue : String; CaseSensitive : Boolean; WriteToFile : Boolean): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldUpdate( DBName : String; TableName : String; FieldNumber : Integer; FieldValue : String; WhereFieldNumber : Integer; WhereFieldValue : String; CaseSensitive : Boolean): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldUpdate( Var T : TTextTable_ads; FieldNumber : Integer; RowNumber : Integer; FieldValue : String; WriteToFile : Boolean): Boolean; OverLoad; //Unit Description UnitIndex Master IndexFunction TextTableFieldAddAToB( Var T : TTextTable_ads; FieldNumberA : Integer; FieldNumberB : Integer; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master IndexFunction TextTableToClientDataset( ClientDataset : TClientDataset; FileName : String; DisplayNames : String; TextTableSchema : String; TextTableData : String): Boolean; (* New Text Table Methods Field Move FromName FromNumber ChangeType ChangeWidth Update *) implementation Uses FileCtrl,Dialogs,ads_strg,dbtables,StdCtrls; //Unit Description UnitIndex Master Indexconst UnitName = 'ads_StrDataSet'; Tag_Table_Start_Before = #12; Tag_Table_Start_After = #13#10; Tag_Table_End_Before = #13#10; Tag_Table_End_After = #13#10#13#10; Tag_Table_End_IncName = False; Tag_FieldSeparator = #9; Tag_RecordSeparator = #13#10; RaiseErrors = False; TextTableDelimiter = #201; TextTableSeparator = #200; Var ProcName : String; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexProcedure RaiseError(UnitName,ProcName:String;E : Exception); Begin If RaiseErrors Then Raise Exception.Create(UnitName+'.'+Procname+' error: '+E.Message); End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction SaveToFile(Var lst : TStringList; FileName: String): Boolean; Var ProcName : String; inCounter: Integer; Begin Result := False;; ProcName := 'SaveToFile'; Try For inCounter := 0 To 80 Do Begin Try lst.SaveToFile(FileName); Result := True; Break; Except sleep(50); End; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDBGetTableDataSet(DBString, TableName : String): String; Var inPos : Integer; sgTag : String; inTagLen : Integer; inDBLen : Integer; sgUpper : String; ProcName : String; Begin Result := ''; ProcName := 'StrDBGetTableDataSet'; Try sgUpper := UpperCase(DBString); sgTag := Tag_Table_Start_Before + UpperCase(TableName) + Tag_Table_Start_After; sgTag := UpperCase(sgTag); inTagLen := Length(sgTag); inDBLen := Length(DBString); inPos := Pos(sgTag,sgUpper); If inPos < 1 Then Exit; DBString := Copy(DBString,inPos+inTagLen,inDBLen-(inPos+inTagLen)+1); sgUpper := UpperCase(DBString); sgTag := Tag_Table_End_Before; If Tag_Table_End_IncName Then sgTag := sgTag + UpperCase(TableName); sgTag := sgTag + Tag_Table_End_After; sgTag := UpperCase(sgTag); inPos := Pos(sgTag,sgUpper); If inPos < 1 Then Exit; Result := Copy(DBString,1,inPos-1); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDBGetTableFieldCount(DBString, TableName : String): Integer; Var inPos : Integer; lst : TStringList; ProcName : String; sgTag : String; sgUpper : String; Begin Result := -1; ProcName := 'StrDBGetTableFieldCount'; Try lst := TStringList.Create(); Try DBString := StrDBGetTableDataSet(DBString, TableName); sgUpper := UpperCase(DBString); sgTag := Tag_RecordSeparator; sgTag := UpperCase(sgTag); inPos := Pos(sgTag,sgUpper); If inPos < 1 Then Begin //Assume empty table with column definitions End Else Begin DBString := Copy(DBString,1,inPos-1); End; If Tag_FieldSeparator <> #13#10 Then Begin DBString := StringReplace( DBString, Tag_FieldSeparator, #13#10, [rfReplaceAll, rfIgnoreCase]); End; lst.Clear; lst.SetText(PChar(DBString)); Result := lst.Count; Finally lst.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDBGetTableRecordCount(DBString, TableName : String): Integer; Var lst : TStringList; ProcName : String; Begin Result := -1; ProcName := 'StrDBGetTableRecordCount'; Try lst := TStringList.Create(); Try DBString := StrDBGetTableDataSet(DBString, TableName); If Tag_RecordSeparator <> #13#10 Then Begin DBString := StringReplace( DBString, Tag_RecordSeparator, #13#10, [rfReplaceAll, rfIgnoreCase]); End; lst.Clear; lst.SetText(PChar(DBString)); Result := lst.Count-1; Finally lst.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDBGetTableFields(DBString, TableName : String): String; Var inPos : Integer; ProcName : String; sgTag : String; sgUpper : String; Begin Result := ''; ProcName := 'StrDBGetTableFields'; Try DBString := StrDBGetTableDataSet(DBString, TableName); sgUpper := UpperCase(DBString); sgTag := Tag_RecordSeparator; sgTag := UpperCase(sgTag); inPos := Pos(sgTag,sgUpper); If inPos < 1 Then Begin //Assume empty table with column definitions End Else Begin DBString := Copy(DBString,1,inPos-1); End; If Tag_FieldSeparator <> #13#10 Then Begin DBString := StringReplace( DBString, Tag_FieldSeparator, #13#10, [rfReplaceAll, rfIgnoreCase]); End; Result := DBString; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDBGetTableFieldNumber(DBString, TableName, FieldName : String): Integer; Var inIndex : Integer; lst : TStringList; ProcName : String; sgUpper : String; Begin Result := -1; ProcName := 'StrDBGetTableFieldNumber'; Try lst := TStringList.Create(); Try DBString := StrDBGetTableFields(DBString, TableName); sgUpper := UpperCase(DBString); TableName:= UpperCase(TableName); lst.Clear; lst.SetText(PChar(sgUpper)); inIndex := lst.IndexOf(FieldName); Result := inIndex; Finally lst.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDBGetTableFieldNameByNumber(DBString, TableName: String; FieldNumber : Integer): String; Var lst : TStringList; ProcName : String; Begin Result := ''; ProcName := 'StrDBGetTableFieldNameByNumber'; Try lst := TStringList.Create(); Try DBString := StrDBGetTableFields(DBString, TableName); lst.Clear; lst.SetText(PChar(DBString)); Try Result := lst[FieldNumber]; Except Result := ''; End; Finally lst.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction ConvTDataSetToStrTable(TableName : String; DataSet : TDataSet): String; Var sgDataSet : String; ProcName : String; inFieldCount : Integer; inCounter : Integer; boActiveState: Boolean; Begin Result := ''; ProcName := 'ConvTDataSetToStrTable'; Try sgDataSet := ''; boActiveState := DataSet.Active; If Not DataSet.Active Then DataSet.Active := True; inFieldCount := DataSet.FieldCount; sgDataSet := sgDataSet + Tag_Table_Start_Before + UpperCase(TableName) + Tag_Table_Start_After; For inCounter := 0 To inFieldCount - 1 Do Begin sgDataSet := sgDataSet + DataSet.Fields[inCounter].DisplayName; If inCounter <> (inFieldCount - 1) Then Begin sgDataSet := sgDataSet + Tag_FieldSeparator; End Else Begin sgDataSet := sgDataSet + Tag_RecordSeparator; End; End; DataSet.First; While Not DataSet.EOF Do Begin For inCounter := 0 To inFieldCount - 1 Do Begin sgDataSet := sgDataSet + DataSet.Fields[inCounter].AsString; If inCounter <> (inFieldCount - 1) Then Begin sgDataSet := sgDataSet + Tag_FieldSeparator; End Else Begin sgDataSet := sgDataSet + Tag_RecordSeparator; End; End; DataSet.Next; End; sgDataSet := sgDataSet + Tag_Table_End_Before; If Tag_Table_End_IncName Then sgDataSet := sgDataSet + TableName; sgDataSet := sgDataSet + Tag_Table_End_After; Result := sgDataSet; DataSet.Active := boActiveState; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDataSetToGrid(StrDataSet:String;Grid:TStringGrid;InsertGetCol:Boolean;SetGetColYes:Boolean):Boolean; Var ProcName : String; lstAllData : TStringList; lstCols : TStringList; sgCols : String; lstRow : TStringList; inPos : Integer; inPosFldSep : Integer; inColCount : Integer; inCounter : Integer; inRow : Integer; inCol : Integer; inColTo : Integer; sgGetValue : String; Begin Result := False; ProcName := 'StrDataSetToGrid'; Try lstAllData := TStringList.Create(); lstCols := TStringList.Create(); lstRow := TStringList.Create(); Try If StrDataSet = '' Then Exit; sgGetValue := 'N'; If SetGetColYes Then sgGetValue := 'Y'; inPos := Pos(Tag_Table_Start_Before,StrDataSet); If inPos <> 0 Then Begin StrDataSet := Copy(StrDataSet,inPos+1,Length(StrDataSet)-inPos+1); inPosFldSep:= Pos(Tag_FieldSeparator,StrDataSet); inPos := Pos(Tag_Table_Start_After,StrDataSet); If inPos <> 0 Then Begin If inPos < inPosFldSep Then Begin StrDataSet := Copy( StrDataSet, inPos+Length(Tag_Table_Start_After), Length(StrDataSet)-inPos+Length(Tag_Table_Start_After)); End; End; End; inPos := Pos(Tag_Table_End_After,StrDataSet); If inPos > 0 Then Begin StrDataSet := Copy(StrDataSet,1,inPos-1)+#200; End; lstAllData.SetText(PChar(StrDataSet)); inPos := Pos(#200,lstAllData[lstAllData.Count-1]); If inPos <> 0 Then Begin inPosFldSep:= Pos(Tag_FieldSeparator,lstAllData[lstAllData.Count-1]); If inPosFldSep = 0 Then Begin lstAllData.Delete(lstAllData.Count-1); End Else Begin lstAllData[lstAllData.Count-1] := StringReplace( lstAllData[lstAllData.Count-1], #200, '', [rfReplaceAll]); End; End; If lstAllData.Count < 1 Then Exit; sgCols := lstAllData[0]; sgCols := StringReplace( sgCols, Tag_FieldSeparator, #13#10, [rfReplaceAll]); lstCols.SetText(PChar(sgCols)); If InsertGetCol Then lstCols.Insert(0,'GET'); inColCount := lstCols.Count; inColTo := inColCount-1; Grid.FixedRows:= 0; Grid.FixedCols:= 0; Grid.RowCount := 1; Grid.ColCount := 1; Grid.Refresh; Grid.ColCount := inColCount; If lstAllData.Count < 2 Then Begin Grid.RowCount := 2; End Else Begin Grid.RowCount := lstAllData.Count; End; Grid.FixedRows:= 1; //Need to clear all cells For inRow := 1 To Grid.RowCount - 1 Do Begin For inCol := 0 To Grid.ColCount - 1 Do Begin Grid.Cells[inCol,inRow] := ''; End; End; For inCounter := 0 To inColCount - 1 Do Begin lstCols[inCounter] := LowerCase(lstCols[inCounter]); lstCols[inCounter] := StringReplace(lstCols[inCounter],'_',#201,[rfReplaceAll]); lstCols[inCounter] := StringReplace(lstCols[inCounter],' ',#201,[rfReplaceAll]); lstCols[inCounter] := UpperCase(Copy(lstCols[inCounter],1,1))+Copy(lstCols[inCounter],2,255); inPos := Pos(#201,lstCols[inCounter]); If inPos > 0 Then Begin While inPos > 0 Do Begin If inPos = 1 Then Begin lstCols[inCounter] := ' '+UpperCase(Copy(lstCols[inCounter],2,1))+Copy(lstCols[inCounter],3,255); End Else Begin lstCols[inCounter] := Copy(lstCols[inCounter],1,inPos-1)+ ' '+ UpperCase(Copy(lstCols[inCounter],inPos+1,1))+ Copy(lstCols[inCounter],inPos+2,255); End; inPos := Pos(#201,lstCols[inCounter]); End; End; Grid.Cells[inCounter,0] := lstCols[inCounter]; End; For inRow := 1 To lstAllData.Count - 1 Do Begin sgCols := lstAllData[inRow]; sgCols := StringReplace( sgCols, Tag_FieldSeparator, #13#10, [rfReplaceAll]); lstRow.SetText(PChar(sgCols)); If InsertGetCol Then lstRow.Insert(0,sgGetValue); For inCol := 0 To inColTo Do Begin If (inCol <= lstRow.Count -1) Then Begin Try Grid.Cells[inCol,inRow] := lstRow[inCol]; Except End; End; End; End; If InsertGetCol Then Begin Grid.FixedCols := 1; Grid.ColWidths[0] := 25; End Else Begin Grid.FixedCols := 0; End; Finally lstAllData .Free; lstCols .Free; lstRow .Free; End; Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDataSetColDeleteByNumber(StrDataSet:String;ColNum:Integer): String; Var ProcName : String; lst : TStringList; inCounter : Integer; sgData : String; sgSep : String; sgRec : String; Begin Result := ''; ProcName := 'StrDataSetColDeleteByNumber'; Try lst := TStringList.Create(); Try lst.Clear; sgData := ''; sgSep := ''; If Tag_RecordSeparator <> #13#10 Then StrDataSet := StringReplace(StrDataSet,Tag_RecordSeparator,#13#10,[rfReplaceAll, rfIgnoreCase]); lst.SetText(PChar(StrDataSet)); For inCounter := 0 To lst.Count - 1 Do Begin sgRec := StrRecordColDeleteByNumber(lst[inCounter],ColNum); sgData := sgData + sgSep + sgRec; If sgSep = '' Then sgSep := Tag_RecordSeparator; End; Result := sgData; Finally lst.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrRecordColDeleteByNumber(StrRecord:String;ColNum:Integer): String; Var ProcName : String; lst : TStringList; sgRec : String; inCounter: Integer; inLastCol: Integer; sgSep : String; Begin Result := ''; ProcName := 'StrRecordColDeleteByNumber'; Try sgRec := ''; sgSep := ''; lst := TStringList.Create(); Try lst.Clear; If StrRecord = '' Then Exit; If Tag_FieldSeparator <> #13#10 Then StrRecord := StringReplace(StrRecord,Tag_FieldSeparator,#13#10,[rfReplaceAll, rfIgnoreCase]); lst.SetText(PChar(StrRecord)); inLastCol := lst.Count-1; If inLastCol = 0 Then Exit; If ColNum = 0 Then Begin For inCounter := 1 To inLastCol Do Begin sgRec := sgRec + sgSep + lst[inCounter]; If sgSep = '' Then sgSep := Tag_FieldSeparator; End; End Else Begin If ColNum = inLastCol Then Begin For inCounter := 0 To inLastCol-1 Do Begin sgRec := sgRec + sgSep + lst[inCounter]; If sgSep = '' Then sgSep := Tag_FieldSeparator; End; End Else Begin For inCounter := 0 To (ColNum-1) Do Begin sgRec := sgRec + sgSep + lst[inCounter]; If sgSep = '' Then sgSep := Tag_FieldSeparator; End; For inCounter := (ColNum+1) To inLastCol Do Begin sgRec := sgRec + sgSep + lst[inCounter]; If sgSep = '' Then sgSep := Tag_FieldSeparator; End; End; End; Result := sgRec; Finally lst.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDataSetColGetNames(StrDataSet : String): String; Var ProcName : String; inPos : Integer; sgFields : String; Begin Result := ''; ProcName := 'StrDataSetColGetNames'; Try inPos := Pos(UpperCase(Tag_RecordSeparator),UpperCase(StrDataSet)); If inPos = 0 Then Exit; sgFields := Copy(StrDataSet,1,inPos-1); If Tag_FieldSeparator <> #13#10 Then Begin sgFields := StringReplace( sgFields, Tag_FieldSeparator, #13#10, [rfReplaceAll, rfIgnoreCase]); End; Result := sgFields; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDataSetColGetCount(StrDataSet : String): Integer; Var ProcName : String; sgFields : String; lst : TStringList; inCount : Integer; Begin Result := -1; ProcName := 'StrDataSetColGetCount'; Try sgFields := StrDataSetColGetNames(StrDataSet); lst := TStringList.Create(); Try lst.Clear; lst.SetText(PChar(sgFields)); inCount := lst.Count; Finally lst.Free; End; Result := inCount; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDataSetColGetNumberByName(StrDataSet,FieldName : String): Integer; Var ProcName : String; sgFields : String; lst : TStringList; inCount : Integer; Begin Result := -1; ProcName := 'StrDataSetColGetNumberByName'; Try sgFields := StrDataSetColGetNames(StrDataSet); lst := TStringList.Create(); Try lst.Clear; lst.SetText(PChar(sgFields)); inCount := lst.IndexOf(FieldName); Finally lst.Free; End; Result := inCount; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDataSetColGetNameByNumber(StrDataSet: String;FieldNumber: Integer ): String; Var ProcName : String; sgFields : String; lst : TStringList; Begin Result := ''; ProcName := 'StrDataSetColGetNameByNumber'; Try sgFields := StrDataSetColGetNames(StrDataSet); lst := TStringList.Create(); Try lst.Clear; lst.SetText(PChar(sgFields)); Result := lst[FieldNumber]; Finally lst.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrDataSetColDeleteByName(StrDataSet, FieldName:String): String; Var ProcName : String; inColNum : Integer; Begin Result := StrDataSet; ProcName := 'StrDataSetColDeleteByName'; Try inColNum := StrDataSetColGetNumberByName(StrDataSet,FieldName); If inColNum = -1 Then Exit; Result := StrDataSetColDeleteByNumber(StrDataSet,inColNum); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrTableColDeleteByNumber(StrDataSet:String;ColNum:Integer): String; Var ProcName : String; sgTableName : String; sgTemp : String; inPos : Integer; Begin Result := StrDataSet; ProcName := 'StrTableColDeleteByNumber'; Try sgTemp := StrDataSet; inPos := Pos(UpperCase(Tag_Table_Start_Before),UpperCase(sgTemp)); If inPos = 0 Then Exit; sgTemp := Copy( sgTemp, inPos+Length(Tag_Table_Start_Before), Length(sgTemp)-Length(Tag_Table_Start_Before)-inPos+1); inPos := Pos(UpperCase(Tag_Table_Start_After),UpperCase(sgTemp)); If inPos = 0 Then Exit; sgTableName := Copy(sgTemp,1,inPos-1); sgTemp := StrDBGetTableDataSet(StrDataSet, sgTableName); sgTemp := StrDataSetColDeleteByNumber(sgTemp,ColNum); Result := ConvStrDatasetToStrTable(sgTableName, sgTemp); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrTableGetTableName(StrDataSet:String): String; Var ProcName : String; sgTableName : String; sgTemp : String; inPos : Integer; Begin Result := ''; ProcName := 'StrTableGetTableName'; Try sgTemp := StrDataSet; inPos := Pos(UpperCase(Tag_Table_Start_Before),UpperCase(sgTemp)); If inPos = 0 Then Exit; sgTemp := Copy( sgTemp, inPos+Length(Tag_Table_Start_Before), Length(sgTemp)-Length(Tag_Table_Start_Before)-inPos+1); inPos := Pos(UpperCase(Tag_Table_Start_After),UpperCase(sgTemp)); If inPos = 0 Then Exit; sgTableName := Copy(sgTemp,1,inPos-1); Result := sgTableName; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrTableColDeleteByName(StrDataSet, FieldName:String): String; Var ProcName : String; inColNum : Integer; sgTableName : String; sgData : String; Begin Result := StrDataSet; ProcName := 'StrTableColDeleteByName'; Try sgTableName := StrTableGetTableName(StrDataSet); inColNum := StrDBGetTableFieldNumber(StrDataSet,sgTableName,FieldName); If inColNum = -1 Then Exit; sgData := StrDBGetTableDataSet(StrDataSet, sgTableName); sgData := StrDataSetColDeleteByNumber(sgData,inColNum); Result := ConvStrDatasetToStrTable(sgTableName, sgData); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrTableMakeTableHeader(TableName:String): String; Var ProcName : String; Begin Result := ''; ProcName := 'StrTableMakeTableHeader'; Try Result := Tag_Table_Start_Before+ TableName+ Tag_Table_Start_After; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction StrTableMakeTableFooter(TableName:String): String; Var ProcName : String; Begin Result := ''; ProcName := 'StrTableMakeTableFooter'; Try Result := Tag_Table_End_Before; If Tag_Table_End_IncName Then Result := Result + TableName; Result := Result + Tag_Table_End_After; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction ConvStrDatasetToStrTable(TableName, StrDataSet : String): String; Var ProcName : String; Begin Result := ''; ProcName := 'ConvStrDatasetToStrTable'; Try Result := StrTableMakeTableHeader(TableName)+ StrDataSet+ StrTableMakeTableFooter(TableName); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction ConvStrTableToTextTable(StrTable,StrTableName,TextDBName,TextTableName:String;KeepSchema:Boolean): Boolean; Var arFldData : Array of Array of String; arFldLen : Array of Integer; arFldNames : Array of String; arFldPrec : Array of Integer; arFldStrt : Array of Integer; arFldTypes : Array of String; boFndBoolean: Boolean; boFndPeriod : Boolean; boFndSlash : Boolean; boFoundAlpha: Boolean; boFoundInt : Boolean; boSchExists : Boolean; inCol : Integer; inCounter : Integer; inFldCount : Integer; inFldLen : Integer; inRow : Integer; inRowCount : Integer; lstData : TStringList; lstRecSch : TStringList; lstSch : TStringList; ProcName : String; sgAlpha : String; sgDelim : String; sgErr : String; sgFld : String; sgInt : String; sgRec : String; sgSep : String; Begin Result := False; ProcName := 'ConvStrTableToTextTable'; Try sgErr := '0'; lstSch := TStringList.Create(); lstData := TStringList.Create(); lstRecSch:= TStringList.Create(); Try sgErr := '1'; inFldCount := 0; If Copy(TextDBName,Length(TextDBName),1) <> '\' Then TextDBName := TextDBName + '\'; If Not DirectoryExists(TextDBName) Then ForceDirectories(TextDBName); If FileExists(TextDBName+TextTableName+'.txt') Then DeleteFile(PChar(TextDBName+TextTableName+'.txt')); If Copy(TextTableName,Length(TextTableName)-2,3) = 'RAW' Then Begin If FileExists(TextDBName+Copy(TextTableName,1,Length(TextTableName)-3)+'.txt') Then DeleteFile(PChar(TextDBName+Copy(TextTableName,1,Length(TextTableName)-3)+'.txt')); End; boSchExists := FileExists(TextDBName+TextTableName+'.sch'); If boSchExists And KeepSchema Then Begin lstSch.LoadFromFile(TextDBName+TextTableName+'.sch'); For inCounter := 1 To 255 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter)]; If sgRec = '' Then Begin inFldCount := inCounter-1; Break; End; End; End Else Begin inFldCount := StrDBGetTableFieldCount(StrTable,StrTableName); End; If inFldCount < 0 Then Exit; sgErr := '2_1'; SetLength(arFldLen , inFldCount); sgErr := '2_2'; SetLength(arFldNames, inFldCount); sgErr := '2_3'; SetLength(arFldPrec , inFldCount); sgErr := '2_4'; SetLength(arFldStrt , inFldCount); sgErr := '2_5'; SetLength(arFldTypes, inFldCount); sgErr := '3'; If boSchExists And KeepSchema Then Begin For inCounter := 0 To inFldCount-1 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter+1)]; sgRec := StringReplace(sgRec,',',#13#10,[rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); arFldNames[inCounter] := lstRecSch[0]; arFldTypes[inCounter] := lstRecSch[1]; arFldLen [inCounter] := StrToInt(lstRecSch[2]); arFldPrec [inCounter] := StrToInt(lstRecSch[3]); arFldStrt [inCounter] := StrToInt(lstRecSch[4]); End; End Else Begin sgRec := StrDBGetTableFields(StrTable,StrTableName); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); For inCounter := 0 To inFldCount-1 Do Begin arFldNames[inCounter] := lstRecSch[inCounter]; arFldTypes[inCounter] := 'CHAR'; arFldLen [inCounter] := 15; arFldPrec [inCounter] := 0; arFldStrt [inCounter] := 0; End; End; sgErr := '4'; lstData.Clear; inRowCount := StrDBGetTableRecordCount(StrTable,StrTableName); If inRowCount > 0 Then Begin SetLength(arFldData,inFldCount,inRowCount); lstData.SetText(PChar(StrDBGetTableDataSet(StrTable,StrTableName))); If lstData.Count < 2 Then Exit; lstData.Delete(0); sgErr := '5'; For inRow := 0 To inRowCount -1 Do Begin sgRec := lstData[inRow]; sgRec := StringReplace(sgRec,Tag_FieldSeparator,#13#10,[rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); For inCol := 0 To inFldCount - 1 Do Begin arFldData[inCol,inRow] := lstRecSch[inCol]; End; End; sgErr := '6'; If Not (boSchExists And KeepSchema) Then Begin //Determine best DataTypes For inCol := 0 To inFldCount - 1 Do Begin arFldLen [inCol] := 1; arFldPrec[inCol] := 0; arFldTypes[inCol]:= 'CHAR'; sgAlpha := ''; sgInt := ''; boFoundAlpha := False; For inRow := 0 To inRowCount - 1 Do Begin If Not boFoundAlpha Then Begin sgAlpha := LettersOnlyAbsolute(arFldData[inCol,inRow]); If sgAlpha <> '' Then Begin boFoundAlpha := True; Break; End; End; End; If boFoundAlpha Then Begin //Can either be CHAR or BOOL boFndBoolean:= True; For inRow := 0 To inRowCount - 1 Do Begin sgAlpha := LettersOnlyAbsolute(arFldData[inCol,inRow]); sgAlpha := UpperCase(sgAlpha); If Not ((sgAlpha = 'T') Or (sgAlpha = 'F') Or (sgAlpha = 'Y') Or (sgAlpha = 'N')) Then Begin boFndBoolean := False; Break; End; End; If boFndBoolean Then Begin arFldTypes[inCol]:= 'BOOL'; arFldLen [inCol] := 1; arFldPrec[inCol] := 0; For inRow := 0 To inRowCount - 1 Do Begin Try arFldData[inCol,inRow] := UpperCase(Copy(arFldData[inCol,inRow],1,1)); If arFldData[inCol,inRow] = 'Y' Then arFldData[inCol,inRow] := 'T'; If arFldData[inCol,inRow] = 'N' Then arFldData[inCol,inRow] := 'F'; Except End; End; End Else Begin arFldTypes[inCol]:= 'CHAR'; arFldLen [inCol] := 1; arFldPrec[inCol] := 0; For inRow := 0 To inRowCount - 1 Do Begin Try inFldLen := Length(arFldData[inCol,inRow]); If inFldLen > arFldLen [inCol] Then arFldLen [inCol] := inFldLen; Except End; End; End; End Else Begin boFoundInt := False; For inRow := 0 To inRowCount - 1 Do Begin If Not boFoundInt Then Begin sgInt := NumbersOnlyAbsKeepMinusAndPeriod(arFldData[inCol,inRow],True); If sgInt <> '' Then Begin boFoundInt := True; Break; End; End; End; If Not boFoundInt Then Begin arFldTypes[inCol]:= 'CHAR'; arFldLen [inCol] := 1; arFldPrec[inCol] := 0; For inRow := 0 To inRowCount - 1 Do Begin Try inFldLen := Length(arFldData[inCol,inRow]); If inFldLen > arFldLen [inCol] Then arFldLen [inCol] := inFldLen; Except End; End; End Else Begin boFndPeriod := False; boFndSlash := False; For inRow := 0 To inRowCount - 1 Do Begin If Not boFoundInt Then Begin If Pos('.',arFldData[inCol,inRow]) > 0 Then Begin boFndPeriod := True; Break; End; End; If Not boFndSlash Then Begin If Pos('/',arFldData[inCol,inRow]) > 0 Then Begin boFndSlash := True; Break; End; End; End; If boFndPeriod Then Begin arFldTypes[inCol]:= 'FLOAT'; arFldLen [inCol] := 20; arFldPrec[inCol] := 6; For inRow := 0 To inRowCount - 1 Do Begin Try arFldData[inCol,inRow] := NumbersOnly(arFldData[inCol,inRow]); Except End; End; End Else Begin If boFndSlash Then Begin arFldTypes[inCol]:= 'DATE'; arFldLen [inCol] := 10; arFldPrec[inCol] := 0; For inRow := 0 To inRowCount - 1 Do Begin Try arFldData[inCol,inRow] := FormatDateTime('mm/dd/yyyy',StrToDateTime(arFldData[inCol,inRow])); Except End; End; End Else Begin arFldTypes[inCol]:= 'LONGINT'; arFldLen [inCol] := 14; arFldPrec[inCol] := 0; For inRow := 0 To inRowCount - 1 Do Begin Try arFldData[inCol,inRow] := NumbersOnlyAbsKeepMinusAndPeriod(arFldData[inCol,inRow],True); Except End; End; End; End; End; End; End; End; sgErr := '7'; lstSch.Clear; lstSch.Add('['+LowerCase(TextTableName)+']'); lstSch.Add('Filetype=VARYING'); lstSch.Add('Delimiter='+#201); lstSch.Add('Separator='+#200); lstSch.Add('CharSet=ascii'); sgErr := '8'; For inCol := 0 To inFldCount - 1 Do Begin sgRec := ''; If inCol = 0 Then Begin arFldStrt[inCol] := 0; End Else Begin arFldStrt[inCol] := arFldStrt[inCol-1]+arFldLen[inCol-1]; End; sgRec := 'Field' + IntToStr(inCol+1) + '=' + arFldNames[inCol] + ',' + arFldTypes[inCol] + ',' + IntToStr(arFldLen [inCol]) + ',' + IntToStr(arFldPrec [inCol]) + ',' + IntToStr(arFldStrt [inCol]); lstSch.Add(sgRec); End; sgErr := '9'; End; lstSch.Clear; lstSch.Add('['+LowerCase(TextTableName)+']'); lstSch.Add('Filetype=VARYING'); lstSch.Add('Delimiter='+#201); lstSch.Add('Separator='+#200); lstSch.Add('CharSet=ascii'); sgErr := '8'; For inCol := 0 To inFldCount - 1 Do Begin sgRec := ''; If inCol = 0 Then Begin arFldStrt[inCol] := 0; End Else Begin arFldStrt[inCol] := arFldStrt[inCol-1]+arFldLen[inCol-1]; End; sgRec := 'Field' + IntToStr(inCol+1) + '=' + arFldNames[inCol] + ',' + arFldTypes[inCol] + ',' + IntToStr(arFldLen [inCol]) + ',' + IntToStr(arFldPrec [inCol]) + ',' + IntToStr(arFldStrt [inCol]); lstSch.Add(sgRec); End; SaveToFile(lstSch,TextDBName+TextTableName+'.SCH'); sgErr := '10'; lstData.Clear; If inRowCount > 0 Then Begin For inRow := 0 To inRowCount - 1 Do lstData.Add(''); sgErr := '11'; For inCol := 0 To inFldCount - 1 Do Begin If arFldTypes[inCol] = 'CHAR' Then Begin sgDelim := #201; End Else Begin sgDelim := ''; End; If inCol = 0 Then Begin sgSep := ''; End Else Begin sgSep := #200; End; For inRow := 0 To inRowCount - 1 Do Begin sgFld := sgSep+sgDelim+arFldData[inCol,inRow]+sgDelim; lstData[inRow] := lstData[inRow] + sgFld; End; End; sgErr := '12'; End Else Begin lstData.Add(#198); End; SaveToFile(lstData,TextDBName+TextTableName+'.txt'); Result := True; Finally lstSch .Free; lstData .Free; lstRecSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldChangeNameByName(DBName,TableName,OldFldName,NewFldName:String): Boolean; Var //arFldData : Array of Array of String; arFldLen : Array of Integer; arFldNames : Array of String; arFldPrec : Array of Integer; arFldStrt : Array of Integer; arFldTypes : Array of String; boSchExists : Boolean; inCol : Integer; inCounter : Integer; inFldCount : Integer; //inRow : Integer; //inRowCount : Integer; lstData : TStringList; lstRecSch : TStringList; lstSch : TStringList; ProcName : String; //sgDelim : String; //sgFld : String; sgRec : String; //sgSep : String; Begin Result := False; ProcName := 'TextTableFieldChangeNameByName'; Try lstSch := TStringList.Create(); lstData := TStringList.Create(); lstRecSch:= TStringList.Create(); Try inFldCount := 0; If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; If Not DirectoryExists(DBName) Then ForceDirectories(DBName); boSchExists := FileExists(DBName+TableName+'.sch'); If boSchExists Then Begin lstSch.LoadFromFile(DBName+TableName+'.sch'); For inCounter := 1 To 255 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter)]; If sgRec = '' Then Begin inFldCount := inCounter-1; Break; End; End; End Else Begin Exit; End; SetLength(arFldLen , inFldCount); SetLength(arFldNames, inFldCount); SetLength(arFldPrec , inFldCount); SetLength(arFldStrt , inFldCount); SetLength(arFldTypes, inFldCount); For inCounter := 0 To inFldCount-1 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter+1)]; sgRec := StringReplace(sgRec,',',#13#10,[rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); arFldNames[inCounter] := lstRecSch[0]; arFldTypes[inCounter] := lstRecSch[1]; arFldLen [inCounter] := StrToInt(lstRecSch[2]); arFldPrec [inCounter] := StrToInt(lstRecSch[3]); arFldStrt [inCounter] := StrToInt(lstRecSch[4]); End; For inCounter := 0 To inFldCount-1 Do Begin If UpperCase(OldFldName) = UpperCase(arFldNames[inCounter]) Then Begin arFldNames[inCounter] := NewFldName; Result := True; Break; End; End; lstSch.Clear; lstSch.Add('['+LowerCase(TableName)+']'); lstSch.Add('Filetype=VARYING'); lstSch.Add('Delimiter='+#201); lstSch.Add('Separator='+#200); lstSch.Add('CharSet=ascii'); For inCol := 0 To inFldCount - 1 Do Begin sgRec := ''; If inCol = 0 Then Begin arFldStrt[inCol] := 0; End Else Begin arFldStrt[inCol] := arFldStrt[inCol-1]+arFldLen[inCol-1]; End; sgRec := 'Field' + IntToStr(inCol+1) + '=' + arFldNames[inCol] + ',' + arFldTypes[inCol] + ',' + IntToStr(arFldLen [inCol]) + ',' + IntToStr(arFldPrec [inCol]) + ',' + IntToStr(arFldStrt [inCol]); lstSch.Add(sgRec); End; lstSch.Add('FieldName1=xyz'); //lstSch.Sorted := True; //lstSch.Sorted := False; //lstSch.Insert(0,'['+LowerCase(TableName)+']'); SaveToFile(lstSch,DBName+TableName+'.SCH'); Finally lstSch .Free; lstData .Free; lstRecSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldChangeNameByNumber(DBName,TableName,NewFldName:String;FldNumber: Integer): Boolean; Var arFldLen : Array of Integer; arFldNames : Array of String; arFldPrec : Array of Integer; arFldStrt : Array of Integer; arFldTypes : Array of String; boSchExists : Boolean; inCol : Integer; inCounter : Integer; inFldCount : Integer; lstData : TStringList; lstRecSch : TStringList; lstSch : TStringList; ProcName : String; sgRec : String; Begin Result := False; ProcName := 'TextTableFieldChangeNameByNumber'; Try lstSch := TStringList.Create(); lstData := TStringList.Create(); lstRecSch:= TStringList.Create(); Try inFldCount := 0; If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; If Not DirectoryExists(DBName) Then ForceDirectories(DBName); boSchExists := FileExists(DBName+TableName+'.sch'); If boSchExists Then Begin lstSch.LoadFromFile(DBName+TableName+'.sch'); For inCounter := 1 To 255 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter)]; If sgRec = '' Then Begin inFldCount := inCounter-1; Break; End; End; End Else Begin Exit; End; If FldNumber < 0 Then Exit; If FldNumber > (inFldCount-1) Then Exit; SetLength(arFldLen , inFldCount); SetLength(arFldNames, inFldCount); SetLength(arFldPrec , inFldCount); SetLength(arFldStrt , inFldCount); SetLength(arFldTypes, inFldCount); For inCounter := 0 To inFldCount-1 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter+1)]; sgRec := StringReplace(sgRec,',',#13#10,[rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); arFldNames[inCounter] := lstRecSch[0]; arFldTypes[inCounter] := lstRecSch[1]; arFldLen [inCounter] := StrToInt(lstRecSch[2]); arFldPrec [inCounter] := StrToInt(lstRecSch[3]); arFldStrt [inCounter] := StrToInt(lstRecSch[4]); End; arFldNames[FldNumber] := NewFldName; lstSch.Clear; lstSch.Add('['+LowerCase(TableName)+']'); lstSch.Add('Filetype=VARYING'); lstSch.Add('Delimiter='+#201); lstSch.Add('Separator='+#200); lstSch.Add('CharSet=ascii'); For inCol := 0 To inFldCount - 1 Do Begin sgRec := ''; If inCol = 0 Then Begin arFldStrt[inCol] := 0; End Else Begin arFldStrt[inCol] := arFldStrt[inCol-1]+arFldLen[inCol-1]; End; sgRec := 'Field' + IntToStr(inCol+1) + '=' + arFldNames[inCol] + ',' + arFldTypes[inCol] + ',' + IntToStr(arFldLen [inCol]) + ',' + IntToStr(arFldPrec [inCol]) + ',' + IntToStr(arFldStrt [inCol]); lstSch.Add(sgRec); End; SaveToFile(lstSch,DBName+TableName+'.SCH'); Result := True; Finally lstSch .Free; lstData .Free; lstRecSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldInsert( DBName, TableName, NewFldName, NewFldType: String; NewFldLength, NewFldDecimals, NewFldNumber: Integer): Boolean; Var arFldData : Array of Array of String; arFldLen : Array of Integer; arFldNames : Array of String; arFldPrec : Array of Integer; arFldStrt : Array of Integer; arFldTypes : Array of String; boSchExists : Boolean; inCol : Integer; inCounter : Integer; inFldCount : Integer; inRow : Integer; inRowCount : Integer; lstData : TStringList; lstRecSch : TStringList; lstSch : TStringList; ProcName : String; //sgDelim : String; sgErr : String; sgFld : String; sgRec : String; sgSep : String; Begin Result := False; ProcName := 'TextTableFieldInsert'; Try sgErr := '0'; lstSch := TStringList.Create(); lstData := TStringList.Create(); lstRecSch:= TStringList.Create(); Try inFldCount := 0; If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; If Not DirectoryExists(DBName) Then ForceDirectories(DBName); If Not FileExists(DBName+TableName+'.sch') Then Exit; If Not FileExists(DBName+TableName+'.txt') Then Exit; boSchExists := FileExists(DBName+TableName+'.sch'); sgErr := '1'; If boSchExists Then Begin lstSch.LoadFromFile(DBName+TableName+'.sch'); For inCounter := 1 To 255 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter)]; If sgRec = '' Then Begin inFldCount := inCounter-1; Break; End; End; End Else Begin Exit; End; sgErr := '2'; If inFldCount < 1 Then Exit; If NewFldNumber < 0 Then NewFldNumber := 0; If NewFldNumber > inFldCount Then NewFldNumber := inFldCount; SetLength(arFldLen , inFldCount+1); SetLength(arFldNames, inFldCount+1); SetLength(arFldPrec , inFldCount+1); SetLength(arFldStrt , inFldCount+1); SetLength(arFldTypes, inFldCount+1); sgErr := '3'; If NewFldNumber = 0 Then Begin //Add new Field then all the rest arFldNames[NewFldNumber] := NewFldName; arFldTypes[NewFldNumber] := NewFldType; arFldLen [NewFldNumber] := NewFldLength; arFldPrec [NewFldNumber] := NewFldDecimals; arFldStrt [NewFldNumber] := 0; For inCounter := 0 To inFldCount-1 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter+1)]; sgRec := StringReplace(sgRec,',',#13#10,[rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); arFldNames[inCounter+1] := lstRecSch[0]; arFldTypes[inCounter+1] := lstRecSch[1]; arFldLen [inCounter+1] := StrToInt(lstRecSch[2]); arFldPrec [inCounter+1] := StrToInt(lstRecSch[3]); arFldStrt [inCounter+1] := StrToInt(lstRecSch[4]); End; End Else Begin If NewFldNumber = inFldCount Then Begin //Add all existing fields the add new field For inCounter := 0 To inFldCount-1 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter+1)]; sgRec := StringReplace(sgRec,',',#13#10,[rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); arFldNames[inCounter] := lstRecSch[0]; arFldTypes[inCounter] := lstRecSch[1]; arFldLen [inCounter] := StrToInt(lstRecSch[2]); arFldPrec [inCounter] := StrToInt(lstRecSch[3]); arFldStrt [inCounter] := StrToInt(lstRecSch[4]); End; arFldNames[NewFldNumber] := NewFldName; arFldTypes[NewFldNumber] := NewFldType; arFldLen [NewFldNumber] := NewFldLength; arFldPrec [NewFldNumber] := NewFldDecimals; arFldStrt [NewFldNumber] := 0; End Else Begin //Add all existing fields up to NewFldNumber - 1 For inCounter := 0 To NewFldNumber - 1 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter+1)]; sgRec := StringReplace(sgRec,',',#13#10,[rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); arFldNames[inCounter] := lstRecSch[0]; arFldTypes[inCounter] := lstRecSch[1]; arFldLen [inCounter] := StrToInt(lstRecSch[2]); arFldPrec [inCounter] := StrToInt(lstRecSch[3]); arFldStrt [inCounter] := StrToInt(lstRecSch[4]); End; //Add new Field arFldNames[NewFldNumber] := NewFldName; arFldTypes[NewFldNumber] := NewFldType; arFldLen [NewFldNumber] := NewFldLength; arFldPrec [NewFldNumber] := NewFldDecimals; arFldStrt [NewFldNumber] := 0; //Add all existing fields from NewFldNumber to the end For inCounter := NewFldNumber To inFldCount-1 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter+1)]; sgRec := StringReplace(sgRec,',',#13#10,[rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); arFldNames[inCounter+1] := lstRecSch[0]; arFldTypes[inCounter+1] := lstRecSch[1]; arFldLen [inCounter+1] := StrToInt(lstRecSch[2]); arFldPrec [inCounter+1] := StrToInt(lstRecSch[3]); arFldStrt [inCounter+1] := StrToInt(lstRecSch[4]); End; End; End; sgErr := '4'; lstData.Clear; lstData.LoadFromFile(DBName+TableName+'.txt'); inRowCount := lstData.Count; SetLength(arFldData,inFldCount+1,inRowCount); If NewFldNumber = 0 Then Begin For inRow := 0 To inRowCount-1 Do Begin sgRec := lstData[inRow]; sgRec := StringReplace( sgRec, TextTableDelimiter, '', [rfReplaceAll]); sgRec := StringReplace( sgRec, TextTableSeparator, #13#10, [rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); //Add new field arFldData[NewFldNumber,inRow] := ''; //Add existing fields For inCol := 0 To inFldCount-1 Do Begin arFldData[inCol+1,inRow] := lstRecSch[inCol]; End; End; End Else Begin If NewFldNumber = inFldCount Then Begin For inRow := 0 To inRowCount - 1 Do Begin sgRec := lstData[inRow]; sgRec := StringReplace( sgRec, TextTableDelimiter, '', [rfReplaceAll]); sgRec := StringReplace( sgRec, TextTableSeparator, #13#10, [rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); //Do existing fields first For inCol := 0 To inFldCount - 1 Do Begin arFldData[inCol,inRow] := lstRecSch[inCol]; End; //Add new field arFldData[NewFldNumber,inRow] := ''; End; End Else Begin For inRow := 0 To inRowCount - 1 Do Begin sgRec := lstData[inRow]; sgRec := StringReplace( sgRec, TextTableDelimiter, '', [rfReplaceAll]); sgRec := StringReplace( sgRec, TextTableSeparator, #13#10, [rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); //Do existing fields first For inCol := 0 To NewFldNumber - 1 Do Begin arFldData[inCol,inRow] := lstRecSch[inCol]; End; //Add new field arFldData[NewFldNumber,inRow] := ''; //Do remaining existing fields For inCol := NewFldNumber To inFldCount-1 Do Begin arFldData[inCol+1,inRow] := lstRecSch[inCol]; End; End; End; End; sgErr := '5'; inFldCount := inFldCount + 1; lstSch.Clear; lstSch.Add('['+LowerCase(TableName)+']'); lstSch.Add('Filetype=VARYING'); lstSch.Add('Delimiter='+TextTableDelimiter); lstSch.Add('Separator='+TextTableSeparator); lstSch.Add('CharSet=ascii'); For inCol := 0 To inFldCount - 1 Do Begin sgRec := ''; If inCol = 0 Then Begin arFldStrt[inCol] := 0; End Else Begin arFldStrt[inCol] := arFldStrt[inCol-1]+arFldLen[inCol-1]; End; sgRec := 'Field' + IntToStr(inCol+1) + '=' + arFldNames[inCol] + ',' + arFldTypes[inCol] + ',' + IntToStr(arFldLen [inCol]) + ',' + IntToStr(arFldPrec [inCol]) + ',' + IntToStr(arFldStrt [inCol]); lstSch.Add(sgRec); End; sgErr := '6'; SaveToFile(lstSch,DBName+TableName+'.SCH'); lstData.Clear; For inRow := 0 To inRowCount - 1 Do Begin sgRec := ''; sgSep := ''; For inCol := 0 To inFldCount - 1 Do Begin sgFld := arFldData[inCol,inRow]; If arFldTypes[inCol] = 'CHAR' Then sgFld := TextTableDelimiter + sgFld + TextTableDelimiter; sgRec := sgRec + sgSep + sgFld; sgSep := TextTableSeparator; End; lstData.Add(sgRec); End; sgErr := '7'; SaveToFile(lstData,DBName+TableName+'.txt'); Result := True; Finally lstSch .Free; lstData .Free; lstRecSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldDeleteByName( DBName, TableName, FieldName: String): Boolean; Var inFldNumber : Integer; ProcName : String; Begin Result := False; ProcName := 'TextTableFieldDeleteByName'; Try inFldNumber := TextTableFieldNumberFromName( DBName, TableName, FieldName); Result := TextTableFieldDeleteByNumber( DBName, TableName, inFldNumber); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldDeleteByNumber( DBName, TableName: String; FieldNumber: Integer): Boolean; Var arFldData : Array of Array of String; arFldLen : Array of Integer; arFldNames : Array of String; arFldPrec : Array of Integer; arFldStrt : Array of Integer; arFldTypes : Array of String; boSchExists : Boolean; inCol : Integer; inCounter : Integer; inFldCount : Integer; inRow : Integer; inFldNumber : Integer; inRowCount : Integer; lstData : TStringList; lstRecSch : TStringList; lstSch : TStringList; ProcName : String; //sgDelim : String; sgErr : String; sgFld : String; sgRec : String; sgSep : String; Begin Result := False; ProcName := 'TextTableFieldDeleteByNumber'; Try If FieldNumber < 0 Then Exit; If FieldNumber > 255 Then Exit; sgErr := '0'; lstSch := TStringList.Create(); lstData := TStringList.Create(); lstRecSch:= TStringList.Create(); Try inFldCount := 0; If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; If Not DirectoryExists(DBName) Then ForceDirectories(DBName); If Not FileExists(DBName+TableName+'.sch') Then Exit; If Not FileExists(DBName+TableName+'.txt') Then Exit; boSchExists := FileExists(DBName+TableName+'.sch'); sgErr := '1'; If boSchExists Then Begin lstSch.LoadFromFile(DBName+TableName+'.sch'); For inCounter := 1 To 255 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter)]; If sgRec = '' Then Begin inFldCount := inCounter-1; Break; End; End; End Else Begin Exit; End; sgErr := '2'; If inFldCount < 1 Then Exit; If FieldNumber > (inFldCount - 1) Then Exit; SetLength(arFldLen , inFldCount); SetLength(arFldNames, inFldCount); SetLength(arFldPrec , inFldCount); SetLength(arFldStrt , inFldCount); SetLength(arFldTypes, inFldCount); sgErr := '3'; For inCounter := 0 To inFldCount-1 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter+1)]; sgRec := StringReplace(sgRec,',',#13#10,[rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); arFldNames[inCounter] := lstRecSch[0]; arFldTypes[inCounter] := lstRecSch[1]; arFldLen [inCounter] := StrToInt(lstRecSch[2]); arFldPrec [inCounter] := StrToInt(lstRecSch[3]); arFldStrt [inCounter] := StrToInt(lstRecSch[4]); End; sgErr := '4'; lstData.Clear; lstData.LoadFromFile(DBName+TableName+'.txt'); inRowCount := lstData.Count; SetLength(arFldData,inFldCount,inRowCount); If inRowCount > 0 Then Begin For inRow := 0 To inRowCount - 1 Do Begin sgRec := lstData[inRow]; sgRec := StringReplace( sgRec, TextTableDelimiter, '', [rfReplaceAll]); sgRec := StringReplace( sgRec, TextTableSeparator, #13#10, [rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); lstRecSch.Add(''); For inCol := 0 To inFldCount - 1 Do Begin arFldData[inCol,inRow] := lstRecSch[inCol]; End; End; End; inFldNumber := FieldNumber; //Set the deleted column to null values arFldNames[inFldNumber] := ''; arFldTypes[inFldNumber] := ''; arFldLen [inFldNumber] := 0; arFldPrec [inFldNumber] := 0; arFldStrt [inFldNumber] := 0; //Recalculate Field Starts For inCol := 0 To inFldCount - 1 Do Begin If inCol = 0 Then Begin arFldStrt[inCol] := 0; End Else Begin arFldStrt[inCol] := arFldStrt[inCol-1]+arFldLen[inCol-1]; End; End; sgErr := '5'; //Build Schema lstSch.Clear; lstSch.Add('['+LowerCase(TableName)+']'); lstSch.Add('Filetype=VARYING'); lstSch.Add('Delimiter='+TextTableDelimiter); lstSch.Add('Separator='+TextTableSeparator); lstSch.Add('CharSet=ascii'); For inCol := 0 To inFldCount - 1 Do Begin If inCol = inFldNumber Then Continue; sgRec := ''; sgRec := 'Field'; If inCol < inFldNumber Then Begin sgRec := sgRec + IntToStr(inCol+1); End Else Begin sgRec := sgRec + IntToStr(inCol); End; sgRec := sgRec + '=' + arFldNames[inCol] + ',' + arFldTypes[inCol] + ',' + IntToStr(arFldLen [inCol]) + ',' + IntToStr(arFldPrec [inCol]) + ',' + IntToStr(arFldStrt [inCol]); lstSch.Add(sgRec); End; sgErr := '6'; SaveToFile(lstSch,DBName+TableName+'.SCH'); lstData.Clear; For inRow := 0 To inRowCount - 1 Do Begin sgRec := ''; sgSep := ''; For inCol := 0 To inFldCount - 1 Do Begin If inCol = inFldNumber Then Continue; sgFld := arFldData[inCol,inRow]; If arFldTypes[inCol] = 'CHAR' Then sgFld := TextTableDelimiter + sgFld + TextTableDelimiter; sgRec := sgRec + sgSep + sgFld; sgSep := TextTableSeparator; End; lstData.Add(sgRec); End; sgErr := '7'; SaveToFile(lstData,DBName+TableName+'.txt'); Result := True; Finally lstSch .Free; lstData .Free; lstRecSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldNumberFromName( DBName, TableName, FieldName: String): Integer; Var inCounter : Integer; inPos : Integer; lstSch : TStringList; ProcName : String; sgErr : String; sgFld : String; sgRec : String; Begin Result := -1; ProcName := 'TextTableFieldNumberFromName'; Try lstSch := TStringList.Create(); Try If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; If Not DirectoryExists(DBName) Then ForceDirectories(DBName); If Not FileExists(DBName+TableName+'.sch') Then Exit; FieldName := UpperCase(FieldName); lstSch.Clear; lstSch.LoadFromFile(DBName+TableName+'.sch'); For inCounter := 1 To 255 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter)]; If sgRec = '' Then Exit; inPos := Pos(',',sgRec); sgFld := UpperCase(Copy(sgRec,1,inPos-1)); If sgFld = FieldName Then Begin Result := inCounter-1; Break; End; End; Finally lstSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldAppend( DBName, TableName, NewFldName, NewFldType: String; NewFldLength, NewFldDecimals: Integer): Boolean; Var ProcName : String; Begin Result := False; ProcName := 'TextTableFieldAppend'; Try Result := TextTableFieldInsert( DBName, //DBName, TableName, //TableName, NewFldName, //NewFldName, NewFldType, //NewFldType: String; NewFldLength, //NewFldLength, NewFldDecimals,//NewFldDecimals, 1000); //NewFldNumber: Integer): Boolean; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldNameFromNumber( DBName, TableName: String; FieldNumber: Integer): String; Var inPos : Integer; lstSch : TStringList; ProcName : String; sgRec : String; Begin Result := ''; ProcName := 'TextTableFieldNameFromNumber'; Try lstSch := TStringList.Create(); Try If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; If Not DirectoryExists(DBName) Then ForceDirectories(DBName); If Not FileExists(DBName+TableName+'.sch') Then Exit; lstSch.Clear; lstSch.LoadFromFile(DBName+TableName+'.sch'); sgRec := lstSch.Values['Field'+IntToStr(FieldNumber+1)]; inPos := Pos(',',sgRec); Result := Copy(sgRec,1,inPos-1); Finally lstSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldTypeFromNumber( DBName, TableName: String; FieldNumber: Integer): String; Var inPos : Integer; lstSch : TStringList; ProcName : String; sgRec : String; Begin Result := ''; ProcName := 'TextTableFieldTypeFromNumber'; Try lstSch := TStringList.Create(); Try If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; If Not DirectoryExists(DBName) Then ForceDirectories(DBName); If Not FileExists(DBName+TableName+'.sch') Then Exit; lstSch.Clear; lstSch.LoadFromFile(DBName+TableName+'.sch'); sgRec := lstSch.Values['Field'+IntToStr(FieldNumber+1)]; inPos := Pos(',',sgRec); sgRec := Copy(sgRec,inPos+1,255); inPos := Pos(',',sgRec); Result:= Copy(sgRec,1,inPos-1); Finally lstSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldTypeFromName( DBName, TableName, FieldName: String): String; Var ProcName : String; inFldNumber : Integer; Begin Result := ''; ProcName := 'TextTableFieldTypeFromName'; Try inFldNumber := TextTableFieldNumberFromName(DBName,TableName,FieldName); If inFldNumber = -1 Then Exit; Result := TextTableFieldTypeFromNumber(DBName,TableName,inFldNumber); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldCount( DBName, TableName: String): Integer; Var inCounter : Integer; lstSch : TStringList; ProcName : String; sgRec : String; Begin Result := -1; ProcName := 'TextTableFieldCount'; Try lstSch := TStringList.Create(); Try If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; If Not DirectoryExists(DBName) Then ForceDirectories(DBName); If Not FileExists(DBName+TableName+'.sch') Then Exit; lstSch.Clear; lstSch.LoadFromFile(DBName+TableName+'.sch'); For inCounter := 1 To 255 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter)]; If sgRec = '' Then Begin Result := inCounter - 1; Break; End; End; Finally lstSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldLengthFromNumber( DBName, TableName: String; FieldNumber: Integer): Integer; Var inPos : Integer; lstSch : TStringList; ProcName : String; sgRec : String; Begin Result := -1; ProcName := 'TextTableFieldLengthFromNumber'; Try lstSch := TStringList.Create(); Try If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; If Not DirectoryExists(DBName) Then ForceDirectories(DBName); If Not FileExists(DBName+TableName+'.sch') Then Exit; lstSch.Clear; lstSch.LoadFromFile(DBName+TableName+'.sch'); sgRec := lstSch.Values['Field'+IntToStr(FieldNumber+1)]; //Discard Field Name inPos := Pos(',',sgRec); sgRec := Copy(sgRec,inPos+1,255); //Discard Field Type inPos := Pos(',',sgRec); sgRec := Copy(sgRec,inPos+1,255); //Get Field Length inPos := Pos(',',sgRec); sgRec := Copy(sgRec,1,inPos-1); Try Result:= StrToInt(sgRec); Except Result := -1; End; Finally lstSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldDecimalsFromNumber( DBName, TableName: String; FieldNumber: Integer): Integer; Var inPos : Integer; lstSch : TStringList; ProcName : String; sgRec : String; Begin Result := -1; ProcName := 'TextTableFieldDecimalsFromNumber'; Try lstSch := TStringList.Create(); Try If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; If Not DirectoryExists(DBName) Then ForceDirectories(DBName); If Not FileExists(DBName+TableName+'.sch') Then Exit; lstSch.Clear; lstSch.LoadFromFile(DBName+TableName+'.sch'); sgRec := lstSch.Values['Field'+IntToStr(FieldNumber+1)]; //Discard Field Name inPos := Pos(',',sgRec); sgRec := Copy(sgRec,inPos+1,255); //Discard Field Type inPos := Pos(',',sgRec); sgRec := Copy(sgRec,inPos+1,255); //Discard Field Length inPos := Pos(',',sgRec); sgRec := Copy(sgRec,inPos+1,255); //Get Field Decimals inPos := Pos(',',sgRec); sgRec := Copy(sgRec,1,inPos-1); Try Result:= StrToInt(sgRec); Except Result := -1; End; Finally lstSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldCopyAToB( DBName, TableName: String; FromFieldNumber, ToFieldNumber:Integer): Boolean; Var ProcName : String; T : TTextTable_ads; inCounter : Integer; Begin Result := False; ProcName := 'TextTableFieldCopyAToB'; Try T.DBName := DBName; T.TableName := TableName; //Hydrate Texttable TextTablePopulate(T); //Copy Values For inCounter := 0 To T.inRowCount-1 Do Begin T.arFldData[ToFieldNumber,inCounter] := T.arFldData[FromFieldNumber,inCounter]; End; //Save Table TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldMoveByNumber( DBName, TableName: String; FromFieldNumber, ToFieldNumber:Integer): Boolean; Var ProcName : String; inFldCount : Integer; sgNewFldName: String; sgNewFldType: String; sgCurFldName: String; inNewFldLen : Integer; inNewFldPrec: Integer; boReturn : Boolean; Begin Result := False; ProcName := 'TextTableFieldMoveByNumber'; Try If FromFieldNumber < 0 Then FromFieldNumber := 0; If ToFieldNumber < 0 Then ToFieldNumber := 0; inFldCount := TextTableFieldCount(DBName,TableName); If FromFieldNumber >= inFldCount Then FromFieldNumber := inFldCount-1; If ToFieldNumber >= inFldCount Then ToFieldNumber := inFldCount-1; If FromFieldNumber = ToFieldNumber Then Begin Result := True; Exit; End; sgNewFldName:= 'qrzrq'; sgCurFldName:= TextTableFieldNameFromNumber(DBName,TableName,FromFieldNumber); sgNewFldType:= TextTableFieldTypeFromNumber(DBName,TableName,FromFieldNumber); inNewFldLen := TextTableFieldLengthFromNumber(DBName,TableName,FromFieldNumber); inNewFldPrec:= TextTableFieldDecimalsFromNumber(DBName,TableName,FromFieldNumber); boReturn := TextTableFieldInsert( DBName, //DBName, TableName, //TableName, sgNewFldName, //NewFldName, sgNewFldType, //NewFldType: String; inNewFldLen, //NewFldLength, inNewFldPrec, //NewFldDecimals, ToFieldNumber); //NewFldNumber: Integer): Boolean; If Not boReturn Then Exit; If FromFieldNumber < ToFieldNumber Then Begin boReturn := TextTableFieldCopyAToB( DBName, //DBName, TableName, //TableName: String; FromFieldNumber,//FromFieldNumber, ToFieldNumber); //ToFieldNumber:Integer): Boolean; If Not boReturn Then Begin //ShowMessage(ProcName+': '+'CopyAToB'+' Failed!'); Exit; End; boReturn := TextTableFieldDeleteByNumber( DBName, //DBName, TableName, //TableName: String; FromFieldNumber);//FieldNumber: Integer): Boolean; If Not boReturn Then Begin //ShowMessage(ProcName+': '+'Delete'+' Failed!'); Exit; End; End else Begin boReturn := TextTableFieldCopyAToB( DBName, //DBName, TableName, //TableName: String; FromFieldNumber+1,//FromFieldNumber, ToFieldNumber); //ToFieldNumber:Integer): Boolean; If Not boReturn Then Begin //ShowMessage(ProcName+': '+'CopyAToB'+' Failed!'); Exit; End; boReturn := TextTableFieldDeleteByNumber( DBName, //DBName, TableName, //TableName: String; FromFieldNumber+1);//FieldNumber: Integer): Boolean; If Not boReturn Then Begin //ShowMessage(ProcName+': '+'Delete'+' Failed!'); Exit; End; End; boReturn := TextTableFieldChangeNameByNumber(DBName,TableName,sgCurFldName,ToFieldNumber); If Not boReturn Then Begin //ShowMessage(ProcName+': '+'Field ReName'+' Failed!'); Exit; End; Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFileWrite(Var T: TTextTable_ads): Boolean; Var inCol : Integer; inRow : Integer; lstData : TStringList; lstRecSch : TStringList; lstSch : TStringList; ProcName : String; sgErr : String; sgFld : String; sgRec : String; sgSep : String; Begin Result := False; ProcName := 'TextTableFileWrite'; Try sgErr := '0'; lstSch := TStringList.Create(); lstData := TStringList.Create(); lstRecSch:= TStringList.Create(); Try //Build Schema lstSch.Clear; lstSch.Add('['+LowerCase(T.TableName)+']'); lstSch.Add('Filetype=VARYING'); lstSch.Add('Delimiter='+TextTableDelimiter); lstSch.Add('Separator='+TextTableSeparator); lstSch.Add('CharSet=ascii'); For inCol := 0 To T.inFldCount - 1 Do Begin sgRec := ''; sgRec := 'Field'; sgRec := sgRec + IntToStr(inCol+1); sgRec := sgRec + '=' + T.arFldNames[inCol] + ',' + T.arFldTypes[inCol] + ',' + IntToStr(T.arFldLen [inCol]) + ',' + IntToStr(T.arFldPrec[inCol]) + ',' + IntToStr(T.arFldStrt[inCol]); lstSch.Add(sgRec); End; sgErr := '6'; SaveToFile(lstSch,T.DBName+T.TableName+'.SCH'); lstData.Clear; For inRow := 0 To T.inRowCount - 1 Do Begin sgRec := ''; sgSep := ''; For inCol := 0 To T.inFldCount - 1 Do Begin sgFld := T.arFldData[inCol,inRow]; If T.arFldTypes[inCol] = 'CHAR' Then sgFld := TextTableDelimiter + sgFld + TextTableDelimiter; sgRec := sgRec + sgSep + sgFld; sgSep := TextTableSeparator; End; lstData.Add(sgRec); End; sgErr := '7'; If lstData.Text = '' Then lstData.Add(' '); SaveToFile(lstData,T.DBName+T.TableName+'.txt'); Result := True; Finally lstSch .Free; lstData .Free; lstRecSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldUpdate( Var T : TTextTable_ads; FieldNumber : Integer; FieldValue : String; WhereFieldNumber : Integer; WhereFieldValue : String; CaseSensitive : Boolean; WriteToFile : Boolean): Boolean; OverLoad; Var inRow : Integer; ProcName : String; sgErr : String; boAllRows : Boolean; Begin Result := False; ProcName := 'TextTableFieldUpdate'; Try sgErr := '0'; If T.inRowCount < 1 Then Begin Result := True; Exit; End; If (WhereFieldNumber < 0) Or (WhereFieldNumber > (T.inFldCount-1)) Then Begin boAllRows := True; CaseSensitive := True; End Else Begin boAllRows := False; End; If CaseSensitive Then Begin If boAllRows Then Begin For inRow := 0 To T.inRowCount - 1 Do Begin T.arFldData[FieldNumber,inRow] := FieldValue; End; End Else Begin For inRow := 0 To T.inRowCount - 1 Do Begin If T.arFldData[WhereFieldNumber,inRow] = WhereFieldValue Then Begin T.arFldData[FieldNumber,inRow] := FieldValue; End; End; End; End Else Begin WhereFieldValue := UpperCase(WhereFieldValue); For inRow := 0 To T.inRowCount - 1 Do Begin If UpperCase(T.arFldData[WhereFieldNumber,inRow]) = WhereFieldValue Then Begin T.arFldData[FieldNumber,inRow] := FieldValue; End; End; End; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldAddAToB( Var T : TTextTable_ads; FieldNumberA : Integer; FieldNumberB : Integer; WriteToFile : Boolean): Boolean; Var inRow : Integer; ProcName : String; sgErr : String; Begin Result := False; ProcName := 'TextTableFieldAddAToB'; Try sgErr := '0'; If T.inRowCount < 1 Then Begin Result := True; Exit; End; For inRow := 0 To T.inRowCount - 1 Do Begin T.arFldData[FieldNumberB,inRow] := T.arFldData[FieldNumberB,inRow]+T.arFldData[FieldNumberA,inRow]; End; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldAddTextBefore( Var T : TTextTable_ads; FieldNumber : Integer; Text : String; WriteToFile : Boolean): Boolean; Var inRow : Integer; ProcName : String; sgErr : String; Begin Result := False; ProcName := 'TextTableFieldAddTextBefore'; Try sgErr := '0'; For inRow := 0 To T.inRowCount - 1 Do Begin T.arFldData[FieldNumber,inRow] := Text+T.arFldData[FieldNumber,inRow]; End; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldAddTextAfter( Var T : TTextTable_ads; FieldNumber : Integer; Text : String; WriteToFile : Boolean): Boolean; Var inRow : Integer; ProcName : String; sgErr : String; Begin Result := False; ProcName := 'TextTableFieldAddTextAfter'; Try sgErr := '0'; If T.inRowCount < 1 Then Begin Result := True; Exit; End; For inRow := 0 To T.inRowCount - 1 Do Begin T.arFldData[FieldNumber,inRow] := T.arFldData[FieldNumber,inRow]+Text; End; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldTrim( Var T : TTextTable_ads; FieldNumber : Integer; WriteToFile : Boolean): Boolean; Var inRow : Integer; ProcName : String; sgErr : String; Begin Result := False; ProcName := 'TextTableFieldTrim'; Try sgErr := '0'; If T.inRowCount < 1 Then Begin Result := True; Exit; End; For inRow := 0 To T.inRowCount - 1 Do Begin T.arFldData[FieldNumber,inRow] := Trim(T.arFldData[FieldNumber,inRow]); End; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldInsert( Var T : TTextTable_ads; NewFldName : String; NewFldType : String; NewFldLength : Integer; NewFldDecimals : Integer; NewFldNumber : Integer; WriteToFile : Boolean): Boolean; OverLoad; Var inRow : Integer; ProcName : String; sgErr : String; inCol : Integer; Begin Result := False; ProcName := 'TextTableFieldInsert2'; Try sgErr := '0'; T.inFldCount := T.inFldCount + 1; SetLength(T.arFldData ,T.inFldCount,T.inRowCount); SetLength(T.arFldLen ,T.inFldCount); SetLength(T.arFldNames ,T.inFldCount); SetLength(T.arFldPrec ,T.inFldCount); SetLength(T.arFldStrt ,T.inFldCount); SetLength(T.arFldTypes ,T.inFldCount); If NewFldNumber < 1 Then Begin For inCol := (T.inFldCount - 1) DownTo 1 Do Begin T.arFldLen [inCol] := T.arFldLen [inCol-1]; T.arFldNames [inCol] := T.arFldNames [inCol-1]; T.arFldPrec [inCol] := T.arFldPrec [inCol-1]; T.arFldStrt [inCol] := T.arFldStrt [inCol-1]; T.arFldTypes [inCol] := T.arFldTypes [inCol-1]; End; For inCol := (T.inFldCount - 1) DownTo 1 Do Begin For inRow := 0 To T.inRowCount - 1 Do Begin T.arFldData[inCol,inRow] := T.arFldData[inCol-1,inRow]; End; End; End Else Begin If NewFldNumber >= (T.inFldCount-1) Then Begin //Keep all Data where it is and append a field End Else Begin For inCol := (T.inFldCount - 1) DownTo (NewFldNumber+1) Do Begin T.arFldLen [inCol] := T.arFldLen [inCol-1]; T.arFldNames [inCol] := T.arFldNames [inCol-1]; T.arFldPrec [inCol] := T.arFldPrec [inCol-1]; T.arFldStrt [inCol] := T.arFldStrt [inCol-1]; T.arFldTypes [inCol] := T.arFldTypes [inCol-1]; End; For inCol := (T.inFldCount - 1) DownTo (NewFldNumber+1) Do Begin For inRow := 0 To T.inRowCount - 1 Do Begin T.arFldData[inCol,inRow] := T.arFldData[inCol-1,inRow]; End; End; End; End; T.arFldLen [NewFldNumber] := NewFldLength; T.arFldNames [NewFldNumber] := NewFldName; T.arFldPrec [NewFldNumber] := NewFldDecimals; T.arFldStrt [NewFldNumber] := 0; T.arFldTypes [NewFldNumber] := NewFldType; For inRow := 0 To T.inRowCount - 1 Do Begin T.arFldData[NewFldNumber,inRow] := ''; End; TextTableFieldStartsRefresh(T,False); If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldStartsRefresh(Var T: TTextTable_ads;WriteToFile:Boolean): Boolean; Var ProcName : String; sgErr : String; inCol : Integer; Begin Result := False; ProcName := 'TextTableRefreshFldStarts'; Try sgErr := '0'; For inCol := 0 To T.inFldCount - 1 Do Begin If inCol = 0 Then Begin T.arFldStrt[inCol] := 0; End Else Begin T.arFldStrt[inCol] := T.arFldStrt[inCol-1]+T.arFldLen[inCol-1]; End; End; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldNumberFromName( Var T : TTextTable_ads; FieldName: String): Integer; OverLoad; Var ProcName : String; sgErr : String; inCol : Integer; Begin Result := -1; ProcName := 'TextTableRefreshFldStarts'; Try sgErr := '0'; FieldName := UpperCase(Trim(FieldName)); For inCol := 0 To T.inFldCount - 1 Do Begin If UpperCase(Trim(T.arFldNames[inCol])) = FieldName Then Begin Result := inCol; Break; End; End; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldDeleteByNumber( Var T : TTextTable_ads; FieldNumber : Integer; WriteToFile : Boolean): Boolean;OverLoad; Var inRow : Integer; ProcName : String; sgErr : String; inCol : Integer; Begin Result := False; ProcName := 'TextTableFieldDeleteByNumber2'; Try sgErr := '0'; For inCol := FieldNumber To (T.inFldCount - 2) Do Begin T.arFldLen [inCol] := T.arFldLen [inCol+1]; T.arFldNames [inCol] := T.arFldNames [inCol+1]; T.arFldPrec [inCol] := T.arFldPrec [inCol+1]; T.arFldStrt [inCol] := T.arFldStrt [inCol+1]; T.arFldTypes [inCol] := T.arFldTypes [inCol+1]; If T.inRowCount > 0 Then Begin For inRow := 0 To T.inRowCount - 1 Do Begin T.arFldData[inCol,inRow] := T.arFldData[inCol+1,inRow]; End; End; End; T.inFldCount := T.inFldCount - 1; If T.inRowCount > 0 Then Begin SetLength(T.arFldData ,T.inFldCount,T.inRowCount); End Else Begin SetLength(T.arFldData ,T.inFldCount,1); End; SetLength(T.arFldLen ,T.inFldCount); SetLength(T.arFldNames ,T.inFldCount); SetLength(T.arFldPrec ,T.inFldCount); SetLength(T.arFldStrt ,T.inFldCount); SetLength(T.arFldTypes ,T.inFldCount); TextTableFieldStartsRefresh(T,False); If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldChangeNameByName(Var T: TTextTable_ads;OldFldName,NewFldName:String;WriteToFile:Boolean): Boolean;OverLoad; Var ProcName : String; sgErr : String; inCol : Integer; Begin Result := False; ProcName := 'TextTableFieldChangeNameByName2'; Try sgErr := '0'; sgErr := '0'; OldFldName := UpperCase(OldFldName); For inCol := 0 To T.inFldCount - 1 Do Begin If UpperCase(T.arFldNames[inCol]) = OldFldName Then Begin T.arFldNames[inCol] := NewFldName; Result := True; Break; End; End; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldDateYYYYMMDDToMMDDYYYY( Var T : TTextTable_ads; FieldNumber : Integer; WriteToFile : Boolean): Boolean; Var ProcName : String; sgErr : String; inRow : Integer; sgFld : String; sgYYYY : String; sgMM : String; sgDD : String; Begin Result := False; ProcName := 'TextTableFieldDateYYYYMMDDToMMDDYYYY'; Try sgErr := '0'; If T.inRowCount < 1 Then Begin Result := True; Exit; End; T.arFldLen [FieldNumber] := 10; T.arFldPrec [FieldNumber] := 0; T.arFldStrt [FieldNumber] := 0; T.arFldTypes[FieldNumber] := 'DATE'; For inRow := 0 To T.inRowCount - 1 Do Begin Try sgYYYY := ''; sgMM := ''; sgDD := ''; sgfld := Trim(T.arFldData[FieldNumber,inRow]); If sgFld = '' Then Continue; sgYYYY := Copy(sgFld,1,4); sgMM := Copy(sgFld,5,2); sgDD := Copy(sgFld,7,2); T.arFldData[FieldNumber,inRow] := sgMM+'/'+sgDD+'/'+sgYYYY; Except End; End; TextTableFieldStartsRefresh(T,False); If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableLookupKeyToValues( Var T : TTextTable_ads; //Table to be modified Var L : TTextTable_ads; //lookup table TKeyFieldNumber : Integer; //Key Field in table to be modified LKeyFieldNumber : Integer; //Key Field in lookup table TValueFieldNumber: Integer; //Field to be modified LValueFieldNumber: Integer; //Lookup Field to add to Table WriteToFile : Boolean): Boolean;//Write to disk when done Var ProcName : String; sgErr : String; lst : TStringList; inRow : Integer; sgKeyValue : String; sgRepValue : String; Begin Result := False; ProcName := 'TextTableLookupKeyToValues'; Try sgErr := '0'; If T.inRowCount < 1 Then Begin Result := True; Exit; End; lst := TStringList.Create(); Try lst.Clear; lst.Sorted := True; lst.Duplicates := dupIgnore; For inRow := 0 To T.inRowCount - 1 Do Begin lst.Add(UpperCase(Trim(T.arFldData[TKeyFieldNumber,inRow]))); End; For inRow := 0 To lst.Count - 1 Do Begin sgKeyValue := lst[inRow]; sgRepValue := TextTableLookupGetValueFromKey( L , //T : TTextTable_ads; //lookup table LKeyFieldNumber , //LookupFieldNumber : Integer; //Key Field in lookup table sgKeyValue , //LookupFieldValue : String; //Key Field Value in lookup table LValueFieldNumber ); //ReturnFieldNumber : Integer):String; //Field Number for value returned TextTableFieldUpdate( T , //Var T : TTextTable_ads; TValueFieldNumber, //FieldNumber : Integer; sgRepValue , //FieldValue : String; TKeyFieldNumber , //WhereFieldNumber : Integer; sgKeyValue , //WhereFieldValue : String; False , //CaseSensitive : Boolean; False ); //WriteToFile : Boolean): Boolean; End; Finally lst.Free; End; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableLookupGetValueFromKey( T : TTextTable_ads; //lookup table LookupFieldNumber : Integer; //Key Field in lookup table LookupFieldValue : String; //Key Field Value in lookup table ReturnFieldNumber : Integer):String;OverLoad; //Field Number for value returned Var ProcName : String; sgErr : String; inRow : Integer; sgFld : String; Begin Result := ''; ProcName := 'TextTableLookupGetValueFromKey'; Try sgErr := '0'; If LookupFieldNumber < 0 Then Exit; If ReturnFieldNumber < 0 Then Exit; sgErr := '1'; LookupFieldValue := UpperCase(Trim(LookupFieldValue)); For inRow := 0 To T.inRowCount - 1 Do Begin sgFld := UpperCase(Trim(T.arFldData[LookupFieldNumber,inRow])); If sgFld = LookupFieldValue Then Begin Result := T.arFldData[ReturnFieldNumber,inRow]; Break; End; End; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableToGrid(Var T:TTextTable_ads;Grid:TStringGrid): Boolean; Var inRow : Integer; inCol : Integer; inColCount : Integer; inCounter : Integer; sgName : String; ProcName : String; procedure StringGridSizeColumns(Grid : TStringGrid); Var inColEndPad: Integer; inCounter : Integer; inRow : Integer; inWidth : Integer; inWidthMax : Integer; lab : TLabel; ProcName : String; begin ProcName := 'StringGridSizeColumns'; Try lab := TLabel.Create(nil); Try inColEndPad := 3; lab.Font := Grid.Font; lab.AutoSize := True; For inCounter := 0 To Grid.ColCount - 1 Do Begin inWidthMax := 4; For inRow := 0 To Grid.RowCount - 1 Do Begin lab.Caption := Grid.Cells[inCounter,inRow]; inWidth := lab.Width; If inWidth > inWidthMax Then inWidthMax := inWidth; End; Grid.ColWidths[inCounter] := inWidthMax+(2*Grid.GridLineWidth)+inColEndPad; End; Finally lab.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; begin Result := False; ProcName := 'TextTabletoGrid'; Try For inRow := 0 To Grid.RowCount - 1 Do Begin For inCol := 0 To Grid.ColCount - 1 Do Begin Grid.Cells[inCol,inRow] := ''; End; End; inColCount := T.inFldCount; Grid.ColCount := inColCount+1; Grid.RowCount := 2; Grid.FixedRows := 1; Grid.FixedCols := 1; Grid.Cells[0,0]:= 'Get'; For inCounter := 0 To inColCount - 1 Do Begin sgName := T.arFldNames[inCounter]; Grid.Cells[inCounter+1,0]:= sgName; End; If T.inRowCount > 0 Then Begin For inRow := 0 To T.inRowCount - 1 Do Begin Grid.RowCount := Grid.RowCount+1; Grid.Cells[0,Grid.RowCount-2]:= 'N'; For inCol := 0 To inColCount - 1 Do Begin If (T.arFldTypes[inCol] = 'DATE') Or (T.arFldTypes[inCol] = 'TIME') Or (T.arFldTypes[inCol] = 'TIMESTAMP') Then Begin Try If Trim(T.arFldData[inCol,inRow]) = '' Then Begin sgName := ''; End Else Begin sgName := FormatDateTime('mm/dd/yyyy',StrToDateTime(T.arFldData[inCol,inRow])); End; Except sgName := ''; End; End Else Begin sgName := T.arFldData[inCol,inRow]; End; Grid.Cells[inCol+1,Grid.RowCount-2]:= sgName; End; End; Grid.RowCount := Grid.RowCount-1; End Else Begin Grid.RowCount := 2; Grid.FixedRows := 1; End; StringGridSizeColumns(Grid); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldPad( Var T : TTextTable_ads; FieldNumber : Integer; FillChar : String; StrLen : Integer; LeftJustify : Boolean; WriteToFile : Boolean): Boolean; Var ProcName : String; inRow : Integer; begin Result := False; ProcName := 'TextTableFieldPad'; Try For inRow := 0 To T.inRowCount - 1 Do Begin T.arFldData[FieldNumber,inRow] := StringPad( T.arFldData[FieldNumber,inRow], //InputStr : String; '0' , //FillChar : String; 8 , //StrLen : Integer; False ); //StrJustify : Boolean): String; End; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableLookupToList( T : TTextTable_ads; //lookup table LookupFieldNumber : Integer; //Field used to populate TStrings lst : TStrings):Boolean; //TStrings list Var ProcName : String; inRow : Integer; begin Result := False; ProcName := 'TextTableLookupToList'; Try lst.Clear; For inRow := 0 To T.inRowCount - 1 Do Begin lst.Add(T.arFldData[LookupFieldNumber,inRow]); End; Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableToGrid(DBName,TableName:String;Grid:TStringGrid): Boolean;OverLoad; Var ProcName : String; T : TTextTable_ads; begin Result := False; ProcName := 'TextTableToGrid'; Try If Copy(DBName,Length(DBName),1) <> '\' Then DBName := DBName + '\'; T.DBName := DBName; T.TableName := TableName; If Not FileExists(DBName + TableName + '.txt') Then Exit; If Not FileExists(DBName + TableName + '.sch') Then Exit; Result := TextTablePopulate(T); If Result Then Result := TextTableToGrid(T,Grid); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldUpdate( DBName : String; TableName : String; FieldNumber : Integer; FieldValue : String; WhereFieldNumber : Integer; WhereFieldValue : String; CaseSensitive : Boolean): Boolean; OverLoad; Var ProcName : String; T : TTextTable_ads; WriteToFile : Boolean; begin Result := False; ProcName := 'TextTableFieldUpdate'; Try T.DBName := DBName; T.TableName := TableName; WriteToFile := True; If Not FileExists(DBName + TableName + '.txt') Then Exit; If Not FileExists(DBName + TableName + '.sch') Then Exit; TextTablePopulate(T); Result := TextTableFieldUpdate( T , //Var T : TTextTable_ads; FieldNumber , //FieldNumber : Integer; FieldValue , //FieldValue : String; WhereFieldNumber , //WhereFieldNumber : Integer; WhereFieldValue , //WhereFieldValue : String; CaseSensitive , //CaseSensitive : Boolean; WriteToFile ); //WriteToFile : Boolean): Boolean; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableLookupGetValueFromKey( DBName : String; //Path to TextTables TableName : String; //TextTable Name no Extension LookupFieldName : String; //Lookup Field Name LookupFieldValue : String; //Lookup Field Value in lookup table ReturnFieldName : String) //Field Name for value returned :String;OverLoad; //A String is returned Var ProcName : String; T : TTextTable_ads; LookupFieldNumber: Integer; ReturnFieldNumber: Integer; begin Result := ''; ProcName := 'TextTableLookupGetValueFromKey'; Try T.DBName := DBName; T.TableName := TableName; If Not FileExists(DBName + TableName + '.txt') Then Exit; If Not FileExists(DBName + TableName + '.sch') Then Exit; TextTablePopulate(T); LookupFieldNumber:= TextTableFieldNumberFromName(T,LookupFieldName); ReturnFieldNumber:= TextTableFieldNumberFromName(T,ReturnFieldName); Result := TextTableLookupGetValueFromKey( T , //T : TTextTable_ads; //lookup table LookupFieldNumber , //LookupFieldNumber : Integer; //Key Field in lookup table LookupFieldValue , //LookupFieldValue : String; //Key Field Value in lookup table ReturnFieldNumber ); //ReturnFieldNumber : Integer):String; //Field Number for value returned Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableLookupGetValueFromRecNo( DBName : String; //Path to TextTables TableName : String; //TextTable Name no Extension RecNo : Integer;//Record Number ReturnFieldName : String) //Field Name for value returned :String; OverLoad; //A String is returned Var ProcName : String; T : TTextTable_ads; ReturnFieldNumber: Integer; begin Result := ''; ProcName := 'TextTableLookupGetValueFromRecNo'; Try T.DBName := DBName; T.TableName := TableName; If Not FileExists(DBName + TableName + '.txt') Then Exit; If Not FileExists(DBName + TableName + '.sch') Then Exit; TextTablePopulate(T); ReturnFieldNumber:= TextTableFieldNumberFromName(T,ReturnFieldName); Result := TextTableLookupGetValueFromRecNo( T , //T : TTextTable_ads; //lookup table RecNo , //RecNo : Integer; //Key Field in lookup table ReturnFieldNumber ); //ReturnFieldNumber : Integer):String; //Field Number for value returned Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableLookupGetValueFromRecNo( T : TTextTable_ads; //lookup table RecNo : Integer; //Record Number ReturnFieldNumber: Integer) //Field Number for value returned :String; OverLoad; //A String is returned Var ProcName : String; sgErr : String; Begin Result := ''; ProcName := 'TextTableLookupGetValueFromRecNo'; Try sgErr := '0'; If RecNo < 0 Then Exit; If RecNo >= T.inRowCount Then Exit; If ReturnFieldNumber < 0 Then Exit; If ReturnFieldNumber >= T.inFldCount Then Exit; Result := T.arFldData[ReturnFieldNumber,RecNo]; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableChangesToNewTable( Var Before : TTextTable_ads; Var After : TTextTable_ads; Var Changed : TTextTable_ads; WriteToFile : Boolean): Boolean; OverLoad; Var ProcName : String; inCol : Integer; inRow : Integer; sgDBName : String; sgTableName : String; lstBefore : TStringList; lstAfter : TStringList; begin //This method does not handle inserts or deletes //This method assumes that record order has not changed Result := False; ProcName := 'TextTableChangesToNewTable'; Try If WriteToFile Then Begin TextTableFileWrite(Before); TextTableFileWrite(After); End; If Changed.TableName = After.TableName Then Exit; If Before.inFldCount <> After.inFldCount Then Exit; If Changed.TableName = '' Then Exit; //This method does not handle inserts or deletes If Before.inRowCount <> After.inRowCount Then Exit; For inCol := 0 To (After.inFldCount - 1) Do Begin If Before.arFldLen [inCol] <> After.arFldLen [inCol] Then Exit; If Before.arFldNames[inCol] <> After.arFldNames[inCol] Then Exit; If Before.arFldPrec [inCol] <> After.arFldPrec [inCol] Then Exit; If Before.arFldStrt [inCol] <> After.arFldStrt [inCol] Then Exit; If Before.arFldTypes[inCol] <> After.arFldTypes[inCol] Then Exit; End; sgDBName := After.DBName; sgTableName := After.TableName; After.DBName := Changed.DBName; After.TableName := Changed.TableName; TextTableFileWrite(After); After.DBName := sgDBName; After.TableName := sgTableName; If FileExists(Changed.DBName+Changed.TableName+'.txt') Then DeleteFile(PChar(Changed.DBName+Changed.TableName+'.txt')); TextTableFileWrite(Before); TextTableFileWrite(After); If Not FileExists(Before.DBName+Before.TableName+'.txt') Then Exit; If Not FileExists(After.DBName +After.TableName +'.txt') Then Exit; lstBefore := TStringList.Create(); lstAfter := TStringList.Create(); Try lstBefore.LoadFromFile(Before.DBName+Before.TableName+'.txt'); lstAfter .LoadFromFile(After .DBName+After.TableName +'.txt'); For inRow := (lstAfter.Count-1) DownTo 0 Do Begin If lstBefore[inRow] = lstAfter[inRow] Then lstAfter.Delete(inRow); End; If lstAfter.Count = 0 Then Exit; lstAfter.SaveToFile(Changed.DBName +Changed.TableName +'.txt'); TextTablePopulate(Changed); Result := True; Finally lstBefore.Free; lstAfter .Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableChangesToNewTable( BeforeDBName : String; BeforeTableName : String; AfterDBName : String; AfterTableName : String; ChangedDBName : String; ChangedTableName : String): Boolean; OverLoad; Var Before : TTextTable_ads; After : TTextTable_ads; Changed : TTextTable_ads; ProcName : String; begin Result := False; ProcName := 'TextTableChangesToNewTable'; Try If Copy(BeforeDBName ,Length(BeforeDBName ),1) <> '\' Then BeforeDBName := BeforeDBName + '\'; If Copy(AfterDBName ,Length(AfterDBName ),1) <> '\' Then AfterDBName := AfterDBName + '\'; If Copy(ChangedDBName,Length(ChangedDBName),1) <> '\' Then ChangedDBName:= ChangedDBName+ '\'; Before.DBName := BeforeDBName; Before.TableName := BeforeTableName; After.DBName := AfterDBName; After.TableName := AfterTableName; Changed.DBName := ChangedDBName; Changed.TableName:= ChangedTableName; TextTablePopulate(Before); TextTablePopulate(After); Result := TextTableChangesToNewTable( Before , //Var Before : TTextTable_ads; After , //Var After : TTextTable_ads; Changed, //Var Changed : TTextTable_ads; True );//WriteToFile : Boolean): Boolean; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableGetRecordNumber( Var T : TTextTable_ads; FieldNumber : Integer; FieldValue : String; CaseSensitive : Boolean; WriteToFile : Boolean): Integer; Var ProcName : String; inRow : Integer; begin Result := -1; ProcName := 'TextTableGetRecordNumber'; Try If CaseSensitive Then Begin For inRow := 0 To T.inRowCount - 1 Do Begin If T.arFldData[FieldNumber,inRow] = FieldValue Then Begin Result := inRow; Break; End; End; End Else Begin FieldValue := UpperCase(FieldValue); For inRow := 0 To T.inRowCount - 1 Do Begin If UpperCase(T.arFldData[FieldNumber,inRow]) = FieldValue Then Begin Result := inRow; Break; End; End; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldUpdate( Var T : TTextTable_ads; FieldNumber : Integer; RowNumber : Integer; FieldValue : String; WriteToFile : Boolean): Boolean; OverLoad; Var ProcName : String; begin Result := False; ProcName := 'TextTableFieldUpdate'; Try T.arFldData[FieldNumber,RowNumber] := FieldValue; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldUpdate( Var T : TTextTable_ads; FieldName : String; RowNumber : Integer; FieldValue : String; WriteToFile : Boolean): Boolean; OverLoad; Var ProcName : String; FieldNumber : Integer; begin Result := False; ProcName := 'TextTableFieldUpdate'; Try FieldNumber := TextTableFieldNumberFromName(T,FieldName); If FieldNumber = -1 Then Exit; Result := TextTableFieldUpdate( T , //Var T : TTextTable_ads; FieldNumber, //FieldNumber : Integer; RowNumber , //RowNumber : Integer; FieldValue , //FieldValue : String; WriteToFile);//WriteToFile : Boolean): Boolean; OverLoad; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableRecordDeleteByNumber( Var T : TTextTable_ads; RowNumber : Integer; WriteToFile : Boolean): Boolean; Var ProcName : String; inRow : Integer; inCol : Integer; begin Result := False; ProcName := 'TextTableRecordDeleteByNumber'; Try If RowNumber < 0 Then Exit; If RowNumber >= T.inRowCount Then Exit; If RowNumber = (T.inRowCount - 1) Then Begin If T.inRowCount <> 1 Then SetLength(T.arFldData,T.inFldCount,T.inRowCount-1); T.inRowCount := T.inRowCount-1; Result := True; Exit; End; For inRow := RowNumber To T.inRowCount -2 Do Begin For inCol := 0 To T.inFldCount - 1 Do Begin T.arFldData[inCol,inRow] := T.arFldData[inCol,inRow+1]; End; End; If T.inRowCount <> 1 Then SetLength(T.arFldData,T.inFldCount,T.inRowCount-1); T.inRowCount := T.inRowCount-1; If WriteToFile Then TextTableFileWrite(T); Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableRecordCopy( Var FromTable : TTextTable_ads; Var ToTable : TTextTable_ads; FromRowNumber : Integer; ToRowNumber : Integer; WriteToFile : Boolean): Boolean; Var ProcName : String; inCol : Integer; FieldName : String; inFld : Integer; begin Result := False; ProcName := 'TextTableRecordCopy'; Try If FromRowNumber < 0 Then Exit; If FromRowNumber >= (FromTable.inRowCount -1) Then Exit; If ToRowNumber < 0 Then Exit; If ToRowNumber >= (ToTable.inRowCount -1) Then Exit; For inCol := 0 To (FromTable.inFldCount - 1) Do Begin FieldName := FromTable.arFldNames[inCol]; inFld := TextTableFieldNumberFromName(ToTable,FieldName); If inFld = -1 Then Continue; ToTable.arFldData[inFld,ToRowNumber] := FromTable.arFldData[inCol,FromRowNumber]; End; Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableLookupGetValueFromKey( T : TTextTable_ads; //lookup table LookupFieldNumber1: Integer; //Key Field in lookup table LookupFieldValue1 : String; //Key Field Value in lookup table LookupFieldNumber2: Integer; //Key Field in lookup table LookupFieldValue2 : String; //Key Field Value in lookup table ReturnFieldNumber : Integer):String;OverLoad; //Field Number for value returned Var ProcName : String; sgErr : String; inRow : Integer; sgFld1 : String; sgFld2 : String; Begin Result := ''; ProcName := 'TextTableLookupGetValueFromKey'; Try sgErr := '0'; If LookupFieldNumber1 < 0 Then Exit; If LookupFieldNumber2 < 0 Then Exit; If ReturnFieldNumber < 0 Then Exit; sgErr := '1'; LookupFieldValue1 := UpperCase(Trim(LookupFieldValue1)); LookupFieldValue2 := UpperCase(Trim(LookupFieldValue2)); For inRow := 0 To T.inRowCount - 1 Do Begin sgFld1 := UpperCase(Trim(T.arFldData[LookupFieldNumber1,inRow])); sgFld2 := UpperCase(Trim(T.arFldData[LookupFieldNumber2,inRow])); If (sgFld1 = LookupFieldValue1) And (sgFld2 = LookupFieldValue2) Then Begin Result := T.arFldData[ReturnFieldNumber,inRow]; Break; End; End; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTableFieldCopyAToB( Var T : TTextTable_ads; FromFieldNumber, ToFieldNumber:Integer): Boolean;OverLoad; Var ProcName : String; inCounter : Integer; Begin Result := False; ProcName := 'TextTableFieldCopyAToB'; Try For inCounter := 0 To T.inRowCount - 1 Do Begin T.arFldData[ToFieldNumber,inCounter] := T.arFldData[FromFieldNumber,inCounter]; End; Result := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master IndexFunction ConvTDataSetToTextTable_ads(DataSet:TDataSet;TableName: String;out TextTableSchema,TextTableData:String): Boolean; OverLoad; Var FieldType : TFieldType; inCounter : Integer; inFieldDec : Integer; inFieldLen : Integer; inFieldNo : Integer; inFieldStrt : Integer; inRow : Integer; lst : TStringList; ProcName : String; sgDataSch : String; sgFieldName : String; sgFieldType : String; sgFld : String; sgRecSch : String; sgSep : String; sgTableName : String; sgTagDelim : String; sgTagSep : String; begin Result := False; ProcName := 'ConvTDataSetToTextTable_ads2'; Try lst := TStringList.Create(); Try // If Copy(TextDatabaseName,Length(TextDatabaseName),1) <> '\' Then // TextDatabaseName := TextDatabaseName + '\'; // If Not DirectoryExists(TextDatabaseName) Then // ForceDirectories(TextDatabaseName); lst.Clear; sgTagSep := #200; sgTagDelim := #201; sgTableName := TableName; inFieldNo := 1; sgSep := ''; sgDataSch := ''; sgDataSch := sgDataSch + '['+sgTableName+']'+ #13#10;; sgDataSch := sgDataSch + 'Filetype=VARYING'+ #13#10;; sgDataSch := sgDataSch + 'Delimiter='+#201+ #13#10;; sgDataSch := sgDataSch + 'Separator='+#200+ #13#10;; sgDataSch := sgDataSch + 'CharSet=ascii'+ #13#10;; inFieldStrt := 0; For inCounter := 0 To DataSet.FieldDefs.Count - 1 Do Begin sgRecSch := ''; sgFieldType := 'UNKNOWN'; sgFieldName := DataSet.FieldDefs[inCounter].DisplayName; FieldType := DataSet.FieldDefs[inCounter].DataType; inFieldLen := 0; inFieldDec := 0; (* CHAR ftString, ftWord, ftMemo, ftFmtMemo, ftFixedChar, ftWideString, FLOAT ftFloat, ftCurrency BOOLEAN ftBoolean, LONGINT ftSmallint, ftInteger, ftLargeint, DATE ftDate, ftTime, ftDateTime, UNKNOWN ftUnknown, ftBCD, ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftGraphic, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftADT, ftArray, ftReference, ftDataSet *) If FieldType in [ ftString, ftWord, ftMemo, ftFmtMemo, ftFixedChar, ftWideString ] Then Begin sgFieldType := 'CHAR'; inFieldLen := DataSet.FieldDefs[inCounter].Size; inFieldDec := 0; End; If FieldType in [ ftFloat, ftCurrency ] Then Begin sgFieldType := 'FLOAT'; inFieldLen := 16; inFieldDec := DataSet.FieldDefs[inCounter].Precision; If inFieldDec = 0 Then inFieldDec := 6; End; If FieldType in [ ftBoolean ] Then Begin sgFieldType := 'BOOL'; inFieldLen := 1; inFieldDec := 0; End; If FieldType in [ ftSmallint, ftInteger, ftLargeint ] Then Begin sgFieldType := 'LONGINT'; inFieldLen := 16; inFieldDec := 0; End; If FieldType in [ ftDate, ftTime, ftDateTime ] Then Begin sgFieldType := 'DATE'; inFieldLen := 22; inFieldDec := 0; End; If sgFieldType = 'UNKNOWN' Then Continue; sgRecSch := 'Field'+ IntToStr(inFieldNo)+ '='+ sgFieldName+','+ sgFieldType+','+ IntToStr(inFieldLen)+','+ IntToStr(inFieldDec)+','+ IntToStr(inFieldStrt); inFieldNo := inFieldNo + 1; sgDataSch := sgDataSch + sgRecSch + #13#10; inFieldStrt := inFieldStrt + inFieldLen; If lst.Text = '' Then Begin DataSet.First; While Not DataSet.EOF Do Begin lst.Add(''); DataSet.Next; End; DataSet.First; End; inRow := -1; DataSet.First; While Not DataSet.EOF Do Begin inRow := inRow + 1; sgFld := DataSet.Fields[inCounter].AsString; If sgFieldType = 'CHAR' Then Begin sgFld := sgTagDelim+sgFld+sgTagDelim; End; sgFld := sgSep + sgFld; lst[inRow] := lst[inRow] + sgFld; DataSet.Next; End; sgSep := sgTagSep; End; Dataset.First; TextTableData := lst.Text; lst.SetText(PChar(sgDataSch)); TextTableSchema := lst.Text; Result := True; Finally lst.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction ConvTDataSetToTextTable_ads(DataSet:TDataSet;TextDatabaseName,TextTableName:String): Boolean; Var lst : TStringList; ProcName : String; sgTableName : String; TextTableSchema : String; TextTableData : String; begin Result := False; ProcName := 'ConvTDataSetToTextTable_ads1'; Try lst := TStringList.Create(); Try If Copy(TextDatabaseName,Length(TextDatabaseName),1) <> '\' Then TextDatabaseName := TextDatabaseName + '\'; If Not DirectoryExists(TextDatabaseName) Then ForceDirectories(TextDatabaseName); ConvTDataSetToTextTable_ads( Dataset , //DataSet:TDataSet; TextTableName , //TableName: String; TextTableSchema, //out TextTableSchema, TextTableData );//TextTableData:String): Boolean; OverLoad; lst.Clear; lst.SetText(PChar(TextTableSchema)); SaveToFile(lst,TextDatabaseName+sgTableName+'.SCH'); lst.Clear; lst.SetText(PChar(TextTableData)); SaveToFile(lst,TextDatabaseName+sgTableName+'.txt'); Result := True; Finally lst.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master IndexFunction TextTablePopulate( Var T : TTextTable_ads; TextTableSchema : String; TextTableData : String): Boolean; Var inCol : Integer; inCounter : Integer; inRow : Integer; lstData : TStringList; lstRecSch : TStringList; lstSch : TStringList; ProcName : String; sgErr : String; sgRec : String; Begin Result := False; ProcName := 'TextTablePopulate'; Try sgErr := '0'; lstSch := TStringList.Create(); lstData := TStringList.Create(); lstRecSch:= TStringList.Create(); Try T.inFldCount := 0; sgErr := '1'; lstSch.SetText(PChar(TextTableSchema)); For inCounter := 1 To 255 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter)]; If sgRec = '' Then Begin T.inFldCount := inCounter-1; Break; End; End; sgErr := '2'; If T.inFldCount < 1 Then Exit; SetLength(T.arFldLen , T.inFldCount); SetLength(T.arFldNames, T.inFldCount); SetLength(T.arFldPrec , T.inFldCount); SetLength(T.arFldStrt , T.inFldCount); SetLength(T.arFldTypes, T.inFldCount); sgErr := '3'; For inCounter := 0 To T.inFldCount-1 Do Begin sgRec := lstSch.Values['Field'+IntToStr(inCounter+1)]; sgRec := StringReplace(sgRec,',',#13#10,[rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); T.arFldNames[inCounter] := Trim(lstRecSch[0]); T.arFldTypes[inCounter] := Trim(lstRecSch[1]); T.arFldLen [inCounter] := StrToInt(lstRecSch[2]); T.arFldPrec [inCounter] := StrToInt(lstRecSch[3]); T.arFldStrt [inCounter] := StrToInt(lstRecSch[4]); End; sgErr := '4'; lstData.Clear; lstData.SetText(PChar(TextTableData)); If lstData.Count = 1 Then Begin If (Pos(#198,lstData[0]) <> 0) Then lstData.Clear; End; If (lstData.Text = '') Then Begin T.inRowCount := 0; SetLength(T.arFldData,T.inFldCount,1); End Else Begin T.inRowCount := lstData.Count; SetLength(T.arFldData,T.inFldCount,T.inRowCount); End; If T.inRowCount > 0 Then Begin For inRow := 0 To T.inRowCount - 1 Do Begin sgRec := lstData[inRow]; sgRec := StringReplace( sgRec, TextTableDelimiter, '', [rfReplaceAll]); sgRec := StringReplace( sgRec, TextTableSeparator, #13#10, [rfReplaceAll]); lstRecSch.Clear; lstRecSch.SetText(PChar(sgRec)); lstRecSch.Add(''); For inCol := 0 To T.inFldCount - 1 Do Begin T.arFldData[inCol,inRow] := lstRecSch[inCol]; End; End; End; //Recalculate Field Starts For inCol := 0 To T.inFldCount - 1 Do Begin If inCol = 0 Then Begin T.arFldStrt[inCol] := 0; End Else Begin T.arFldStrt[inCol] := T.arFldStrt[inCol-1]+T.arFldLen[inCol-1]; End; End; sgErr := '5'; Result := True; Finally lstSch .Free; lstData .Free; lstRecSch.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master Index//Unit Description UnitIndex Master IndexFunction TextTablePopulate(Var T: TTextTable_ads): Boolean; Var boSchExists : Boolean; lstData : TStringList; lstSch : TStringList; ProcName : String; sgErr : String; TextTableSchema : String; TextTableData : String; Begin Result := False; ProcName := 'TextTablePopulate'; Try sgErr := '0'; lstSch := TStringList.Create(); lstData := TStringList.Create(); Try T.inFldCount := 0; If Copy(T.DBName,Length(T.DBName),1) <> '\' Then T.DBName := T.DBName + '\'; If Not DirectoryExists(T.DBName) Then ForceDirectories(T.DBName); If Not FileExists(T.DBName+T.TableName+'.sch') Then Exit; boSchExists := FileExists(T.DBName+T.TableName+'.sch'); sgErr := '1'; If boSchExists Then Begin lstSch.LoadFromFile(T.DBName+T.TableName+'.sch'); TextTableSchema := lstSch.Text; lstData.Clear; If FileExists(T.DBName+T.TableName+'.txt') Then lstData.LoadFromFile(T.DBName+T.TableName+'.txt'); TextTableData := lstData.Text; Result := TextTablePopulate( T , //Var T : TTextTable_ads; TextTableSchema, //TextTableSchema : String; TextTableData );//TextTableData : String): Boolean; End Else Begin Exit; End; Finally lstSch .Free; lstData .Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName+sgErr,E); End; End; //Unit Description UnitIndex Master IndexFunction TextTableToClientDataset( ClientDataset : TClientDataset; FileName : String; DisplayNames : String; TextTableSchema : String; TextTableData : String): Boolean; Var T : TTextTable_ads; inCounter : Integer; cds : TClientDataset; DataType : TFieldType; sgType : String; inRow : Integer; inCol : Integer; sgTemp : String; lstDisplay: TStringList; Begin Result := False; ProcName := 'TextTableToClientDataset'; Try cds := TClientDataset.Create(nil); lstDisplay:= TStringList.Create(); Try TextTablePopulate( T , //Var T : TTextTable_ads; TextTableSchema, //TextTableSchema : String; TextTableData );//TextTableData : String): Boolean; DisplayNames := StringReplace(DisplayNames,',',#13,[rfReplaceAll]); lstDisplay.SetText(PChar(DisplayNames)); For inCounter := 0 To T.inFldCount - 1 Do Begin sgType := UpperCase(T.arFldTypes[inCounter]); DataType := ftString; If sgType = 'CHAR' Then DataType := ftString; If sgType = 'FLOAT' Then DataType := ftFloat; If sgType = 'BOOL' Then DataType := ftBoolean; If sgType = 'DATE' Then DataType := ftDateTime; If sgType = 'LONGINT' Then DataType := ftInteger; cds.FieldDefs.Insert(inCounter); cds.FieldDefs[inCounter].DataType := DataType; cds.FieldDefs[inCounter].Name := T.arFldNames[inCounter]; cds.FieldDefs[inCounter].Precision := T.arFldPrec[inCounter]; cds.FieldDefs[inCounter].Size := T.arFldLen[inCounter]; End; If lstDisplay.Count = cds.FieldDefs.Count Then Begin For inCounter := 0 To cds.FieldDefs.Count - 1 Do Begin If Trim(lstDisplay[inCounter]) <> '' Then cds.FieldDefs[inCounter].DisplayName := lstDisplay[inCounter]; End; End; cds.CreateDataSet; cds.Active := True; For inRow := 0 To T.inRowCount - 1 Do Begin cds.Insert; For inCol := 0 To T.inFldCount - 1 Do Begin sgTemp := T.arFldData[inCol,inRow]; cds.Fields[inCol].AsString := sgTemp; End; Try cds.Post; Except End; End; ClientDataset.Active := False; If Trim(FileName) <> '' Then Begin ClientDataset.FileName := FileName; ClientDataset.LoadFromFile(FileName); End Else Begin ClientDataset.Data := cds.Data; End; ClientDataset.Active := True; Result := True; Finally cds .Free; lstDisplay.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; Initialization ProcName := 'Unknown'; end. ////