{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@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 maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
Please note if you are viewing this Delphi unit as a web page all you have to
do to turn it into a Delphi unit is save it with a ".pas" extension. The
html in the unit should not affect its performance.
}
unit ads_StrDataSet;
(*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
*)
interface
{
Description: 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.
}
Uses SysUtils, DB, Classes, Grids, Windows, dbClient;
Type
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 Index
Function ConvTDataSetToTextTable_ads(DataSet:TDataSet;TextDatabaseName,TextTableName:String): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function ConvTDataSetToTextTable_ads(DataSet:TDataSet;TableName: String;out TextTableSchema,TextTableData:String): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function ConvStrDatasetToStrTable(TableName, StrDataSet : String): String; //Return: StrTable //Unit Description UnitIndex Master Index
Function ConvTDataSetToStrTable(TableName : String; DataSet : TDataSet): String; //Return: StrTable //Unit Description UnitIndex Master Index
Function StrDBGetTableDataSet(DBString, TableName : String): String; //Return: StrDataset //Unit Description UnitIndex Master Index
Function StrDBGetTableFieldCount(DBString, TableName : String): Integer; //Return: Field Count //Unit Description UnitIndex Master Index
Function StrDBGetTableFieldNameByNumber(DBString, TableName: String; FieldNumber : Integer): String;//Return: Field Name //Unit Description UnitIndex Master Index
Function StrDBGetTableFieldNumber(DBString, TableName, FieldName : String): Integer; //Return: Field Number //Unit Description UnitIndex Master Index
Function StrDBGetTableFields(DBString, TableName : String): String; //Return: Field list //Unit Description UnitIndex Master Index
Function StrDBGetTableRecordCount(DBString, TableName : String): Integer; //Return: Record Count //Unit Description UnitIndex Master Index
Function StrDataSetColDeleteByName(StrDataSet, FieldName:String): String; //Return: StrDataset //Unit Description UnitIndex Master Index
Function StrDataSetColDeleteByNumber(StrDataSet:String;ColNum:Integer): String; //Return: StrDataset //Unit Description UnitIndex Master Index
Function StrDataSetColGetCount(StrDataSet : String): Integer; //Return: Field Count //Unit Description UnitIndex Master Index
Function StrDataSetColGetNameByNumber(StrDataSet: String;FieldNumber: Integer ): String;//Return: Field Name //Unit Description UnitIndex Master Index
Function StrDataSetColGetNames(StrDataSet : String): String; //Return: Field list //Unit Description UnitIndex Master Index
Function StrDataSetColGetNumberByName(StrDataSet,FieldName : String): Integer; //Return: Field Number //Unit Description UnitIndex Master Index
Function StrDataSetToGrid(StrDataSet:String;Grid:TStringGrid;InsertGetCol:Boolean;SetGetColYes:Boolean):Boolean; //Unit Description UnitIndex Master Index
Function StrRecordColDeleteByNumber(StrRecord:String;ColNum:Integer): String; //Return: StrRecord //Unit Description UnitIndex Master Index
Function StrTableColDeleteByName(StrDataSet, FieldName:String): String; //Return: StrTable //Unit Description UnitIndex Master Index
Function StrTableColDeleteByNumber(StrDataSet:String;ColNum:Integer): String; //Return: StrTable //Unit Description UnitIndex Master Index
Function StrTableGetTableName(StrDataSet:String): String; //Return: StrTable Table Name //Unit Description UnitIndex Master Index
Function StrTableMakeTableFooter(TableName:String): String; //Return: StrTable Footer //Unit Description UnitIndex Master Index
Function StrTableMakeTableHeader(TableName:String): String; //Return: StrTable Header //Unit Description UnitIndex Master Index
Function TextTableRecordDeleteByNumber( Var T : TTextTable_ads; RowNumber : Integer; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master Index
Function TextTableRecordCopy( Var FromTable : TTextTable_ads; Var ToTable : TTextTable_ads; FromRowNumber : Integer; ToRowNumber : Integer; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master Index
Function TextTableChangesToNewTable( BeforeDBName : String; BeforeTableName : String; AfterDBName : String; AfterTableName : String; ChangedDBName : String; ChangedTableName : String): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function TextTableChangesToNewTable( Var Before : TTextTable_ads; Var After : TTextTable_ads; Var Changed : TTextTable_ads; WriteToFile : Boolean): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function TextTableGetRecordNumber( Var T : TTextTable_ads; FieldNumber : Integer; FieldValue : String; CaseSensitive : Boolean; WriteToFile : Boolean): Integer; //Unit Description UnitIndex Master Index
Function TextTableFieldPad( Var T : TTextTable_ads; FieldNumber : Integer; FillChar : String; StrLen : Integer; LeftJustify : Boolean; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master Index
Function TextTableFieldTrim( Var T : TTextTable_ads; FieldNumber : Integer; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master Index
Function 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 Index
Function 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 Index
Function 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 Index
Function 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 Index
Function 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 Index
Function 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 Index
Function TextTableLookupToList( T : TTextTable_ads; //lookup table LookupFieldNumber : Integer; //Field used to populate TStrings lst : TStrings):Boolean; //TStrings list //Unit Description UnitIndex Master Index
Function TextTableFieldChangeNameByName( DBName,TableName,OldFldName,NewFldName:String): Boolean;OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldChangeNameByName( Var T: TTextTable_ads;OldFldName,NewFldName:String; WriteToFile:Boolean): Boolean;OverLoad; //Unit Description UnitIndex Master Index
Function TextTableToGrid(Var T:TTextTable_ads;Grid:TStringGrid): Boolean;OverLoad; //Unit Description UnitIndex Master Index
Function TextTableToGrid(DBName,TableName:String;Grid:TStringGrid): Boolean;OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldChangeNameByNumber(DBName,TableName,NewFldName:String;FldNumber: Integer): Boolean; //Unit Description UnitIndex Master Index
Function TextTableFieldInsert( DBName, TableName, NewFldName, NewFldType: String; NewFldLength, NewFldDecimals, NewFldNumber: Integer): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldInsert( Var T : TTextTable_ads; NewFldName : String; NewFldType : String; NewFldLength : Integer; NewFldDecimals : Integer; NewFldNumber : Integer; WriteToFile : Boolean): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldCount( DBName, TableName: String): Integer; //Unit Description UnitIndex Master Index
Function TextTableFieldTypeFromNumber( DBName, TableName: String; FieldNumber: Integer): String; //Unit Description UnitIndex Master Index
Function TextTableFieldLengthFromNumber( DBName, TableName: String; FieldNumber: Integer): Integer; //Unit Description UnitIndex Master Index
Function TextTableFileWrite(Var T: TTextTable_ads): Boolean; //Unit Description UnitIndex Master Index
Function TextTableFieldDecimalsFromNumber( DBName, TableName: String; FieldNumber: Integer): Integer; //Unit Description UnitIndex Master Index
Function TextTableFieldCopyAToB( DBName, TableName: String; FromFieldNumber, ToFieldNumber:Integer): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldCopyAToB( Var T : TTextTable_ads; FromFieldNumber, ToFieldNumber:Integer): Boolean;OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldMoveByNumber( DBName, TableName: String; FromFieldNumber, ToFieldNumber:Integer): Boolean; //Unit Description UnitIndex Master Index
Function TextTableFieldTypeFromName( DBName, TableName, FieldName: String): String; //Unit Description UnitIndex Master Index
Function TextTableFieldAppend( DBName, TableName, NewFldName, NewFldType: String; NewFldLength, NewFldDecimals: Integer): Boolean; //Unit Description UnitIndex Master Index
Function TextTableFieldDeleteByName( DBName, TableName, FieldName: String): Boolean; //Unit Description UnitIndex Master Index
Function TextTableFieldDeleteByNumber( DBName, TableName: String; FieldNumber: Integer): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldDeleteByNumber( Var T : TTextTable_ads; FieldNumber : Integer; WriteToFile : Boolean): Boolean;OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldDateYYYYMMDDToMMDDYYYY( Var T : TTextTable_ads; FieldNumber : Integer; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master Index
Function TextTableFieldNumberFromName( DBName, TableName, FieldName: String): Integer;OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldNumberFromName( Var T : TTextTable_ads; FieldName: String): Integer; OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldNameFromNumber( DBName, TableName: String; FieldNumber: Integer): String; //Unit Description UnitIndex Master Index
Function TextTablePopulate(Var T: TTextTable_ads): Boolean; Overload; //Unit Description UnitIndex Master Index
Function TextTablePopulate( Var T : TTextTable_ads; TextTableSchema : String; TextTableData : String): Boolean; Overload; //Unit Description UnitIndex Master Index
Function TextTableFieldStartsRefresh(Var T: TTextTable_ads;WriteToFile:Boolean): Boolean; //Unit Description UnitIndex Master Index
Function TextTableFieldAddTextBefore( Var T : TTextTable_ads; FieldNumber : Integer; Text : String; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master Index
Function TextTableFieldAddTextAfter( Var T : TTextTable_ads; FieldNumber : Integer; Text : String; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master Index
Function TextTableFieldUpdate( Var T : TTextTable_ads; FieldNumber : Integer; FieldValue : String; WhereFieldNumber : Integer; WhereFieldValue : String; CaseSensitive : Boolean; WriteToFile : Boolean): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldUpdate( DBName : String; TableName : String; FieldNumber : Integer; FieldValue : String; WhereFieldNumber : Integer; WhereFieldValue : String; CaseSensitive : Boolean): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldUpdate( Var T : TTextTable_ads; FieldNumber : Integer; RowNumber : Integer; FieldValue : String; WriteToFile : Boolean): Boolean; OverLoad; //Unit Description UnitIndex Master Index
Function TextTableFieldAddAToB( Var T : TTextTable_ads; FieldNumberA : Integer; FieldNumberB : Integer; WriteToFile : Boolean): Boolean; //Unit Description UnitIndex Master Index
Function 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;
const
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 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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 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
Function 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
Function 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 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
Function 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 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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
Function 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 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
Function 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
Function 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
Function 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 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
Function 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
Function 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
Function 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 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
Function 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
Function 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
Function 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
Function 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
Function 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 Index
Function 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
Function 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 Index
Function 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
Function 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 Index
Function 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.
//