Bu unit program String database işleminde kullanılır.
Kod: Tümünü seç
unit ads_StrDataSet;
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;
Function ConvStrTableToTextTable(StrTable,StrTableName,TextDBName,TextTableName:String;KeepSchema:Boolean): Boolean;
Function ConvTDataSetToTextTable_ads(DataSet:TDataSet;TextDatabaseName,TextTableName:String): Boolean; OverLoad;
Function ConvTDataSetToTextTable_ads(DataSet:TDataSet;TableName: String;out TextTableSchema,TextTableData:String): Boolean; OverLoad;
Function ConvStrDatasetToStrTable(TableName, StrDataSet : String): String; //Return: StrTable
Function ConvTDataSetToStrTable(TableName : String; DataSet : TDataSet): String; //Return: StrTable
Function StrDBGetTableDataSet(DBString, TableName : String): String; //Return: StrDataset
Function StrDBGetTableFieldCount(DBString, TableName : String): Integer; //Return: Field Count
Function StrDBGetTableFieldNameByNumber(DBString, TableName: String; FieldNumber : Integer): String;//Return: Field Name
Function StrDBGetTableFieldNumber(DBString, TableName, FieldName : String): Integer; //Return: Field Number
Function StrDBGetTableFields(DBString, TableName : String): String; //Return: Field list
Function StrDBGetTableRecordCount(DBString, TableName : String): Integer; //Return: Record Count
Function StrDataSetColDeleteByName(StrDataSet, FieldName:String): String; //Return: StrDataset
Function StrDataSetColDeleteByNumber(StrDataSet:String;ColNum:Integer): String; //Return: StrDataset
Function StrDataSetColGetCount(StrDataSet : String): Integer; //Return: Field Count
Function StrDataSetColGetNameByNumber(StrDataSet: String;FieldNumber: Integer ): String;//Return: Field Name
Function StrDataSetColGetNames(StrDataSet : String): String; //Return: Field list
Function StrDataSetColGetNumberByName(StrDataSet,FieldName : String): Integer; //Return: Field Number
Function StrDataSetToGrid(StrDataSet:String;Grid:TStringGrid;InsertGetCol:Boolean;SetGetColYes:Boolean):Boolean;
Function StrRecordColDeleteByNumber(StrRecord:String;ColNum:Integer): String; //Return: StrRecord
Function StrTableColDeleteByName(StrDataSet, FieldName:String): String; //Return: StrTable
Function StrTableColDeleteByNumber(StrDataSet:String;ColNum:Integer): String; //Return: StrTable
Function StrTableGetTableName(StrDataSet:String): String; //Return: StrTable Table Name
Function StrTableMakeTableFooter(TableName:String): String; //Return: StrTable Footer
Function StrTableMakeTableHeader(TableName:String): String; //Return: StrTable Header
Function TextTableRecordDeleteByNumber(
Var T : TTextTable_ads;
RowNumber : Integer;
WriteToFile : Boolean): Boolean;
Function TextTableRecordCopy(
Var FromTable : TTextTable_ads;
Var ToTable : TTextTable_ads;
FromRowNumber : Integer;
ToRowNumber : Integer;
WriteToFile : Boolean): Boolean;
Function TextTableChangesToNewTable(
BeforeDBName : String;
BeforeTableName : String;
AfterDBName : String;
AfterTableName : String;
ChangedDBName : String;
ChangedTableName : String): Boolean; OverLoad;
Function TextTableChangesToNewTable(
Var Before : TTextTable_ads;
Var After : TTextTable_ads;
Var Changed : TTextTable_ads;
WriteToFile : Boolean): Boolean; OverLoad;
Function TextTableGetRecordNumber(
Var T : TTextTable_ads;
FieldNumber : Integer;
FieldValue : String;
CaseSensitive : Boolean;
WriteToFile : Boolean): Integer;
Function TextTableFieldPad(
Var T : TTextTable_ads;
FieldNumber : Integer;
FillChar : String;
StrLen : Integer;
LeftJustify : Boolean;
WriteToFile : Boolean): Boolean;
Function TextTableFieldTrim(
Var T : TTextTable_ads;
FieldNumber : Integer;
WriteToFile : Boolean): Boolean;
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
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
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
Function TextTableLookupGetValueFromRecNo(
T : TTextTable_ads; //lookup table
RecNo : Integer; //Record Number
ReturnFieldNumber: Integer) //Field Number for value returned
:String; OverLoad; //A String is returned
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
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
Function TextTableLookupToList(
T : TTextTable_ads; //lookup table
LookupFieldNumber : Integer; //Field used to populate TStrings
lst : TStrings):Boolean; //TStrings list
Function TextTableFieldChangeNameByName(
DBName,TableName,OldFldName,NewFldName:String): Boolean;OverLoad;
Function TextTableFieldChangeNameByName(
Var T: TTextTable_ads;OldFldName,NewFldName:String;
WriteToFile:Boolean): Boolean;OverLoad;
Function TextTableToGrid(Var T:TTextTable_ads;Grid:TStringGrid): Boolean;OverLoad;
Function TextTableToGrid(DBName,TableName:String;Grid:TStringGrid): Boolean;OverLoad;
Function TextTableFieldChangeNameByNumber(DBName,TableName,NewFldName:String;FldNumber: Integer): Boolean;
Function TextTableFieldInsert(
DBName,
TableName,
NewFldName,
NewFldType: String;
NewFldLength,
NewFldDecimals,
NewFldNumber: Integer): Boolean; OverLoad;
Function TextTableFieldInsert(
Var T : TTextTable_ads;
NewFldName : String;
NewFldType : String;
NewFldLength : Integer;
NewFldDecimals : Integer;
NewFldNumber : Integer;
WriteToFile : Boolean): Boolean; OverLoad;
Function TextTableFieldCount(
DBName,
TableName: String): Integer;
Function TextTableFieldTypeFromNumber(
DBName,
TableName: String;
FieldNumber: Integer): String;
Function TextTableFieldLengthFromNumber(
DBName,
TableName: String;
FieldNumber: Integer): Integer;
Function TextTableFileWrite(Var T: TTextTable_ads): Boolean;
Function TextTableFieldDecimalsFromNumber(
DBName,
TableName: String;
FieldNumber: Integer): Integer;
Function TextTableFieldCopyAToB(
DBName,
TableName: String;
FromFieldNumber,
ToFieldNumber:Integer): Boolean; OverLoad;
Function TextTableFieldCopyAToB(
Var T : TTextTable_ads;
FromFieldNumber,
ToFieldNumber:Integer): Boolean;OverLoad;
Function TextTableFieldMoveByNumber(
DBName,
TableName: String;
FromFieldNumber,
ToFieldNumber:Integer): Boolean;
Function TextTableFieldTypeFromName(
DBName,
TableName,
FieldName: String): String;
Function TextTableFieldAppend(
DBName,
TableName,
NewFldName,
NewFldType: String;
NewFldLength,
NewFldDecimals: Integer): Boolean;
Function TextTableFieldDeleteByName(
DBName,
TableName,
FieldName: String): Boolean;
Function TextTableFieldDeleteByNumber(
DBName,
TableName: String;
FieldNumber: Integer): Boolean; OverLoad;
Function TextTableFieldDeleteByNumber(
Var T : TTextTable_ads;
FieldNumber : Integer;
WriteToFile : Boolean): Boolean;OverLoad;
Function TextTableFieldDateYYYYMMDDToMMDDYYYY(
Var T : TTextTable_ads;
FieldNumber : Integer;
WriteToFile : Boolean): Boolean;
Function TextTableFieldNumberFromName(
DBName,
TableName,
FieldName: String): Integer;OverLoad;
Function TextTableFieldNumberFromName(
Var T : TTextTable_ads;
FieldName: String): Integer; OverLoad;
Function TextTableFieldNameFromNumber(
DBName,
TableName: String;
FieldNumber: Integer): String;
Function TextTablePopulate(Var T: TTextTable_ads): Boolean; Overload;
Function TextTablePopulate(
Var T : TTextTable_ads;
TextTableSchema : String;
TextTableData : String): Boolean; Overload;
Function TextTableFieldStartsRefresh(Var T: TTextTable_ads;WriteToFile:Boolean): Boolean;
Function TextTableFieldAddTextBefore(
Var T : TTextTable_ads;
FieldNumber : Integer;
Text : String;
WriteToFile : Boolean): Boolean;
Function TextTableFieldAddTextAfter(
Var T : TTextTable_ads;
FieldNumber : Integer;
Text : String;
WriteToFile : Boolean): Boolean;
Function TextTableFieldUpdate(
Var T : TTextTable_ads;
FieldNumber : Integer;
FieldValue : String;
WhereFieldNumber : Integer;
WhereFieldValue : String;
CaseSensitive : Boolean;
WriteToFile : Boolean): Boolean; OverLoad;
Function TextTableFieldUpdate(
DBName : String;
TableName : String;
FieldNumber : Integer;
FieldValue : String;
WhereFieldNumber : Integer;
WhereFieldValue : String;
CaseSensitive : Boolean): Boolean; OverLoad;
Function TextTableFieldUpdate(
Var T : TTextTable_ads;
FieldNumber : Integer;
RowNumber : Integer;
FieldValue : String;
WriteToFile : Boolean): Boolean; OverLoad;
Function TextTableFieldAddAToB(
Var T : TTextTable_ads;
FieldNumberA : Integer;
FieldNumberB : Integer;
WriteToFile : Boolean): Boolean;
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;
Procedure RaiseError(UnitName,ProcName:String;E : Exception);
Begin
If RaiseErrors Then Raise Exception.Create(UnitName+'.'+Procname+' error: '+E.Message);
End;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
Function 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;
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;
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;
Function 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;
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;
Function 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;
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;
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;
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;
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;
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;