I have an Delphi 4 application, that extracts data from XLS 2003 sheets (filled Forms ) and inserts into SQL2005 DB .
i have a group of fields in XSL and SQL2005 called.In the Delphi code it is correspondingly called 133, 167 etc.The words around "smrBgm133GallonsGross, .." i.e "smrBgm" and "GrossGallons" are concatinated accordingly in the Delphi files.
SQL/XLS Delphi
smrBgm133GallonsGross... 133
smrBgm167GallonsGross ... 167
For the above I added a new field called in XSL/SQL called smrBgm167GallonsGrossDA
But the PROBLEM is in the Delphi it should be NAMED AS 229, NOT as 'smrBgm167GallonsGrossDA' (as per some biz rules;coz the Delphi appl, processes both EDI/XLS and EDI accepts 229)Hence getting an error while inserting and updating data via the EXCEL sheets ."saying 229 not found in DB".
(Excel sheets it is named as 'smrBgm167GallonsGrossDA' where as in Delphi it is named as '229').
How to tell the Delphi application....
"if it is " smrBgm167GallonsGrossDA" then consider it as "229"?????????????
Not entirely sure what you need, I can't make head nor tail from what you specificly are asking but perhaps this gets you on the right path.
function ExtractNumber(const Value: string): Integer;
begin
if Value = 'smrBgm167GallonsGrossDA' then
Result := 229
else
Result := YourNormalFunctionToExtractTheNumber(Value);
end;
if copy(fieldname, Length(fieldname) - 2, 2) = 'DA' then
begin
delphiField = 229
end
???
You can create a lookup table. Which can be used to lookup the name.
For example:
const
cSize = 2;
cNames : array[0..cSize-1] of string = (
'Name1', 'Name2'
);
CNumbers : array[0..cSize-1] of Integer = (
99, 123
);
function Convert(const AName: string): Integer;
var
i : Integer;
begin
i := 0;
while (i<cSize) do begin
if cNames[i] = AName then begin
Result := cNumbers[i];
Exit;
end;
Inc(i);
end;
Result := NormalConvert(AName);
end;
Note you can also use one array of records:
type
TLookupRec = record
name : string;
number : Integer;
end;
const
cSize = 2;
cLookup : array[0..cSize-1] of TLookupRec = (
( name : 'Name1'; number : 99; ),
( name : 'Name2'; number : 123; )
);
function Convert(const AName: string): Integer;
var
i : Integer;
begin
i := 0;
while (i<cSize) do begin
if cLookUp[i].name = AName then begin
Result := cLookUp[i].number;
Exit;
end;
Inc(i);
end;
Result := NormalConvert(AName);
end;
Related
I have several hardcoded validations like these:
const
cLstAct = 1;
cLstOrg = 4;
cLstClockAct = 11;
const
FUNCT_1 = 224;
FUNCT_2 = 127;
FUNCT_3 = 3;
if lFuncID in [FUNCT_1,FUNCT_2,FUNCT_3] then ...
if not (lListType in [cLstAct..cLstOrg,cLstClockAct]) then ...
if not (lPurpose in [0..2]) then ...
that I want to replace with a common method like
function ValidateInSet(AIntValue: integer; AIntSet: ###): Boolean;
begin
Result := (AIntValue in AIntSet);
if not Result then ...
end;
but what type to choose for AIntSet?
Currently the values to be tested throughout the code go up to a const value 232 (so I can e.g. use a TByteSet = Set of Byte), but I can foresee that we will bump into the E1012 Constant expression violates subrange bounds when the constant values exceed 255.
My Google-fu fails me here...
(Currently on Delphi Seattle Update 1)
Use a dictionary, TDictionary<Integer, Integer>. The value is irrelevant and you only care about the key. If the dictionary contains a specific key then that key is a member of the set. Use AddOrSetValue to add a member, Remove to delete a member and ContainsKey to test membership.
The point of using a dictionary is that it gives you O(1) lookup.
You don't want to use this type directly as a set. You should wrap it in a class that just exposes set like capabilities. An example of that can be found here: https://stackoverflow.com/a/33530037/505088
You can use an array of Integer:
function ValidateInSet(AIntValue: integer; AIntSet: array of Integer): Boolean;
var
I: Integer;
begin
Result := False;
for I := Low(AIntSet) to High(AIntSet) do
begin
if AIntSet[I] = AIntValue then
begin
Result := True;
Break;
end;
end;
if not Result then ...
end;
const
cLstAct = 1;
cLstOrg = 4;
cLstClockAct = 11;
const
FUNCT_1 = 224;
FUNCT_2 = 127;
FUNCT_3 = 3;
if ValidateInSet(lFuncID, [FUNCT_1, FUNCT_2, FUNCT_3]) then ...
if not ValidateInSet(lListType, [cLstAct, 2, 3, cLstOrg, cLstClockAct]) then ...
if not ValidateInSet(lPurpose, [0, 1, 2]) then ...
If you are on a recent Delphi version, you can use TArray<Integer>.
function ValidateInSet(AIntValue: integer; const AIntSet: TArray<Integer>): Boolean;
var
N: Integer;
begin
{ option1 : if AIntSet is always sorted }
result := TArray.BinarySearch(AIntSet, AIntValue, N);
{ option 2: works for any array }
result := false;
for N in AIntSet do begin
if AIntValue = N then begin
result := true;
Break;
end;
end;
if not Result then begin
// ...
end;
end;
Calling is merely the same as with a set (except for ranges):
if ValidateInSet(lFuncID, [FUNCT_1,FUNCT_2,FUNCT_3]) then begin
end;
The direct answer would be TBits class
http://docwiki.embarcadero.com/Libraries/Seattle/en/System.Classes.TBits.Bits
Note: This can only be used starting with Delphi XE4 though - http://qc.embarcadero.com/wc/qcmain.aspx?d=108829
However for your "Set of integers" it in most inflated case would take 2^31 / 8 bytes of memory (because negative values of integer would not be even considered), and that would be a lot...
So I hope you would never really want to have a set of the whole integer. Or you should invest into Sparse Arrays instead.
function ValidateInSet(const AIntValue: integer; const AIntSet: TBits): Boolean;
begin
Result := (AIntValue >= 0) and (AIntValue < AIntSet.Size);
if Result then
Result := AIntSet.Bits[AIntValue];
if not Result then ...
v-a-l-i-d-a-t-e
end;
or rather
function ValidateInSet(const AIntValue: integer; const AIntSet: TBits): Boolean;
begin
Result := false;
if AIntValue < 0 then exit; // Validation criterion #1
if AIntValue >= AIntSet.Size then exit; // Validation criterion #2
if not AIntSet.Bits[AIntValue] then exit; // Validation criterion #3
if .... then exit; // Validation criterion #4
if .... then exit; // Validation criterion #5
if .... then exit; // Validation criterion #6
Result := true;
end;
or perhaps
TSetTestCriterion = TFunc<Integer, Boolean>;
TSetTestCriteria = TArray<TFunc<Integer, Boolean>>;
function ValidateInSet(const AIntValue: integer;
const AIntSet: TBits; const Tests: TSetTestCriteria = nil): Boolean;
var ExtraTest: TSetTestCriterion;
begin
Result := false;
if AIntValue < 0 then exit; // Validation criterion #1
if AIntValue >= AIntSet.Size then exit; // Validation criterion #2
if not AIntSet.Bits[AIntValue] then exit; // Validation criterion #3
if Tests <> nil then // Validation criteria #4, #5, #6, ...
for ExtraTest in Tests do
if not ExtraTest(AIntValue) then exit;
Result := true;
end;
http://docwiki.embarcadero.com/Libraries/Seattle/en/System.SysUtils.TFunc
Now - just for demo, in real app you would create those set and array once and cache for long (forever, or at least unless the configuration change would demand rebuilding them).
Type FuncIDs = ( FUNCT_3 = 3, FUNCT_2 = 127, FUNCT_1 = 224);
var MysticGlobalFlag: Boolean;
function ValidateFuncID( const lFuncID: FuncIDs): Boolean;
var map: TBits;
begin
map := TBits.Create;
try
map.Size := High(lFuncID) + 1;
map.Bits[ Ord(Func_1) ] := True;
map.Bits[ Ord(Func_2) ] := True;
map.Bits[ Ord(Func_3) ] := True;
Result := ValidateInSet( Ord(lFuncID), map,
TSetTestCriteria.Create(
function( lFuncID: integer) : Boolean
begin
Result := MysticGlobalFlag or (lFuncID <> Ord(FuncIDs.FUNC_2))
end
,
function( lFuncID: integer) : Boolean
begin
Result := (lFuncID <> Ord(FuncIDs.FUNC_3)) or (DayOfTheWeek(Now()) = 4)
end
)
);
finally
map.Destroy;
end;
if not Result then // from the original question code
... // seems like a placeholder for error handling or object creation and registration
end;
All, I know it's years since people answered this, but here is a new solution using Delphi generics: -
interface
uses
System.Generics.Defaults;
type
TUtilityArray<T> = class
public
class function Contains(const x : T; const an_array : array of T) : boolean;
end;
implementation
class function TUtilityArray<T>.Contains(const x: T; const an_array: array of T): boolean;
var
y : T;
l_comparer : IEqualityComparer<T>;
begin
Result := false;
l_comparer := TEqualityComparer<T>.Default;
for y in an_array do
begin
if l_comparer.Equals(x, y) then
begin
Result := true;
break;
end;
end;
end;
end.
To use include the class, then write if(TUtilityArray<integer>.Contains(some integer value, [value1, value2 etc.])) then .... An added benefit of this method is that it works for other primitives as well.
I am desperately trying to do a Locate on a record whose PK is associated to Column 0 in a TDBAdvGrid. The TMS Component Pack version I have is 6.8.something.
I am using it in a Win7x64 with Delphi XE 1.
PageMode is turned off because I will need sorting and grouping at the client level(no backend db for now, only client datasets in offline mode).
My code for the locate is like this:
procedure TMainFrm.EditAction;
var ItemID : Integer;
ItemIDStr: String;
begin
// With PageMode set to false(which we need), the dataset is not synchronized.
//ItemID := GetActionGrid.Columns[ 0 ].Field.AsInteger;
ItemIDStr := GetActionGrid.Cells[ 0,GetActionGrid.SelectedRow[ 0 ] ];
ItemID := StrToIntDef( ItemIDStr ,-1 );
// GetActionGrid.Fields[ 0 ].AsInteger;
If DMMain.CLNActions.Locate( 'ITEM_ID',ItemID,[] ) Then
CreateApplicationForm( TActionFrm, True );
end;
But it does not work because the ItemIDStr always returns an empty string.
I am really short of ideas now.
Suggestions?
Thank you!
function TFrameDBGrid1.GrFindValInCol(FldName, FldVal : String) : boolean; //search value in a certain column of the grid
var
StartCell:TPoint;
FindParams: TFindParams;
rv:TPoint;
CurrCol: integer;
I: Integer;
const CResultInvalidInt=-1;
begin
Result := false;
StartCell.x := CResultInvalidInt;
StartCell.y := CResultInvalidInt;
CurrCol := GetColumnIndexOfField(FldName);
grdGlobal.FindCol := CurrCol;
FindParams := [fnMatchRegular, fnFindInPresetCol];
rv:=grdGlobal.Find(StartCell, FldVal, FindParams);
Result:= (rv.x <> CResultInvalidInt) and (rv.y <> CResultInvalidInt);
if Result then
if grdGlobal.Row <> rv.y then
grdGlobal.Row := rv.y;
end;
I am trying to manipulate a string and pull only certain data from it. I need to do this on a record pulled from a database that gives me the full name of a person. I need to pull only the last name from the string and store it as a variable. Is there a way that I can do this?
Example: SQL query pulls the full field "Mary Ellen Jones" I need to extract only the Jones from the string so I can store it in a variable for further processing.
I thought maybe AnsiRightStr would work but the problem is needing to give it a set integer to pull from the right. Maybe a way to count the characters after the final space allowing me to use AnsiRightStr(string,int) for this? Any help at all is appreciated.
Additional thought: Would replacing the spaces with a delimiter say :: and then parsing that data into a Stringlist followed by allowing me to pull the last index of the string list be possible?
Several valid options have been presented so far. None of them address the situation if say the name is Something like "John St. James, Jr." Is this impossible?
you can use the LastDelimiter function to get the last space position and then with the copy function extract the substring.
uses
SysUtils;
var
Name : string;
p : Integer;
ShortName : string;
begin
Name:='Mary Ellen Jones';
//You can call trim to avoid problems with ending spaces in this case is not necesary, just is a test
//Name:=Trim(Name);
//get the last space position
p:=LastDelimiter(' ',Name);
//get the name
ShortName:=Copy(Name,p+1,length(Name)-p);
end;
or using a function
function GetLast(const Name:string) : string;
var
p : Integer;
begin
Result:=Trim(Name);
p:=LastDelimiter(' ',Result);
Result:=Copy(Result,p+1,length(Result)-p);
end;
function GetLastWord(const Str: string): string;
var
p: integer;
i: Integer;
const
SPACE = #$20;
begin
p := 1;
for i := length(Str) downto 1 do
if Str[i] = SPACE then
begin
p := i + 1;
break;
end;
result := Copy(Str, p, MaxInt);
end;
This will fail if the string ends with (an accidental) space, as 'Andreas Rejbrand '. This more robust version will handle this case too:
function GetLastWord(const Str: string): string;
var
p: integer;
i: Integer;
FoundNonSpace: boolean;
const
SPACE = #$20;
begin
p := 1;
FoundNonSpace := false;
for i := length(Str) downto 1 do
if (Str[i] = SPACE) and FoundNonSpace then
begin
p := i + 1;
break
end
else if Str[i] <> SPACE then
FoundNonSpace := true;
result := TrimRight(Copy(Str, p, MaxInt));
end;
What if the last name is say "St. James" any way to account for that?
Here's my approach.
Make a list of lastname-markers
Search that list in order of preference
As soon as a match is found, mark that as the start of last name
Return substring starting from that pos.
var
LastNameMarkers: TStringList = nil;
SuffixFix: TStringList = nil;
procedure InitLists;
begin
LastNameMarkers:= TStringList.Create;
//LastNameMarkers.LoadFromFile('c:\markers.txt');
LastNameMarkers.Add(' St.');
LastnameMarkers.Add(' Mc');
LastNameMarkers.Add(' '); //Marker of last resort.
SuffixFix:= TStringList.Create;
SuffixFix.Add(' Jr.');
SuffixFix.Add(' Sr.');
end;
function GetLastName(FullName: string): string;
var
i: integer;
start: integer;
found: boolean;
ReplaceWith: string;
begin
if LastNameMarkers = nil then InitLists;
//Fix suffixes
i:= 0;
found:= false;
while (i < SuffixFix.Count) and not found do begin
start:= pos(lower(LastNameMarkers[i]),lower(Fullname));
found:= Start > 0;
Inc(i);
end; {while}
if Found then begin
Dec(i);
ReplaceWith:= StringReplace(Suffix[i], ' ', '_',[]);
FullName:= StringReplace(FullName, SuffixFix[i], ReplaceWith,[]);
end; {if}
//Look for lastnames
i:= 0;
found:= false;
while (i < LastNameMarkers.Count) and not found do begin
start:= pos(LastNameMarkers[i],Fullname);
found:= Start > 0;
Inc(i);
end; {while}
if found then Result:= RightStr(FullName, Length(FullName)- Start + 2)
else Result:= '';
StringReplace(Result, '_', ' ',[]);
end;
I haven't dealt with upper and lowercase properly, but I hope you get the idea.
function TfrmCal.GetLastName(FullName: string): string;
var
i: integer;
found: boolean;
suffix: string;
marker: string;
begin
// Build the lists for the compare.
InitLists;
// Look at Suffixes and attach them to the LastName
i := 0;
found := False;
while (i < SuffixFix.Count) do
begin
if AnsiContainsStr(FullName, SuffixFix[i]) then
begin
suffix := '::' + trim(SuffixFix[i]);
FullName := ReplaceStr(FullName, SuffixFix[i], suffix);
found := True;
end;
inc(i);
if found then
break;
end;
// Look for LastName Markers
i := 0;
found := False;
while (i < LastNameMarkers.Count) do
begin
if AnsiContainsStr(FullName, LastNameMarkers[i]) then
begin
marker := trimright(LastNameMarkers[i]) + '::';
FullName := ReplaceStr(FullName, LastNameMarkers[i], marker);
found := True;
end;
inc(i);
if found then
break;
end;
FullName := GetLastWord(FullName);
FullName := ReplaceStr(FullName, '::', ' ');
LastNameMarkers.Clear;
SuffixFix.Clear;
Result := FullName;
end;
function TfrmCal.GetLastWord(const Str: string): string;
var
p: integer;
i: integer;
const
SPACE = #$20;
begin
p := 1;
for i := Length(Str) downto 1 do
if Str[i] = SPACE then
begin
p := i + 1;
break;
end;
Result := Copy(Str, p, MaxInt);
end;
These two functions together pull off what I needed to do. There is also the initlists function which is clunky and ugly and I need to work on so I didn't post it here.
I'm writing a section of code to read in CSV files and parse information out of them (currently I just have the beginning part of the code which will read in the headers at the beginning of the file. When I try to compile this code I'm receiving an error on the line which takes the length of the line from file.
The error I'm recieving is: [Error] MCLRandomizer.pas(*): Missing operator or semicolon
while not EOF(csvFile) do begin
i :=0;
ReadLn(csvFile, line);
if lineOne = true then begin
length := Length(line); //error here
while length > 0 do begin
dx := Pos(',', line);
buffer := Copy(line, 0, dx-1);
headers[i] := buffer;
line := Copy(line, dx+1, length);
length := Length(line); //error here
end;
lineOne := false;
end;
end;
Pascal makes no difference between length and Length ... they both are LENGTH
Rename the variable, it messes up the function.
FTR: If you really, really want you can write
length := System.Length(line);
(assuming length is an Integer). I agree with the other posters that that would be a bad idea.
A solution I developed to read a csv file into a record structure (actually an array of records structures) is
program read_file_into_array_of_records;
{$APPTYPE CONSOLE}
uses
SysUtils, StrUtils;
type
Tscore = record
name : string [25];
marks : integer;
end;
var
input_file: TextFile;
file_record : string[100];
score : array [0..3] of Tscore;
index : integer;
// function that returns all text up to a comma or the end of the line
function get_value() : string;
var
comma_pos: integer;
value: string[100];
begin
comma_pos := Pos(',', file_record);
// if comma found cut out all text up to it
if comma_pos <> 0 then
begin
value := leftstr(file_record, comma_pos - 1);
delete(file_record, 1, comma_pos);
end
else
begin
// no comma found so just take everything that remains
value := file_record;
end;
get_value := value;
end;
// procedure to fill one record by breaking up the comma separated values
procedure fill_record (index: integer);
begin
// call the function get_value as many times as needed to get
// each comma separated value
score[index].name := get_value();
score[index].marks := strtoint(get_value());
end;
// procedure to fill array with contents of csv file
procedure fill_array ();
begin
index := 0;
while not EoF(input_file) do
begin
readln(input_file, file_record);
fill_record (index);
index := index + 1;
end;
end;
// procedure to display contents of array
procedure display_array ();
begin
for index := 0 to 3 do
begin
writeln(score[index].name, ' got ', score[index].marks, ' marks' );
end;
readln;
end;
// main prog
begin
assignfile(input_file, 'scores.csv');
reset(input_file);
fill_array ();
closefile(input_file);
display_array();
end.
the contents of scores.csv:
james,31
jane,23
toby,34
ruth,40
Moreover, Pascal strings at 1, not 0. (copy() statement)
I have a status which is stored as a string of a set length, either in a file or a database.
I'm looking to enumerate the possible status'
I have the following type to define the possible status'
Type TStatus = (fsNormal = Ord('N'),fsEditedOnScreen = Ord('O'),
fsMissing = Ord('M'),fsEstimated = Ord('E'),fsSuspect = Ord('s'),
fsSuspectFromOnScreen = Ord('o'),fsSuspectMissing = Ord('m'),
fsSuspectEstimated = Ord('e'));
Firstly is this really a good idea? or should I have a seperate const array storing the char conversions? That would mean more than one place to update.
Now convert a string to a status array I have the following, but how can I check if a char is valid without looping through the enumeration?
Function StrToStatus(Value : String):TStatusArray;
var
i: Integer;
begin
if Trim(Value) = '' then
begin
SetLength(Result,0);
Exit;
end;
SetLength(Result,Length(Value));
for i := 1 to Length(Value) do
begin
Result[i] := TStatus(Value[i]); // I don't think this line is safe.
end;
end;
After some testing it sames the suspect line is safe (it doesn't crash!) but just adds in (out of bounds) values which then need filtering out.
Function StrToStatus(Value : String):TStatusArray;
var
i: Integer;
begin
if Trim(Value) = '' then
begin
SetLength(Result,0);
Exit;
end;
SetLength(Result,Length(Value));
for i := 1 to Length(Value) do
begin
Result[i-1] := TStatus(Value[i]);
end;
for i := 0 to Length(Result) - 1 do
begin
case Result[i] of
fsNormal: ;
fsEditedOnScreen: ;
fsMissing: ;
fsEstimated: ;
fsSuspect: ;
fsSuspectFromOnScreen: ;
fsSuspectMissing: ;
fsSuspectEstimated: ;
else
Result [i] := fsNormal;
end;
end;
end;
This allows all the status' and their relative Char values to be in one place and prevents looping through every status for every character in the string. (So in my head atleast should be a bit faster)
AFAIK this should be fine for converting back again.
Function StatusToStr(Value : TStatusArray):String;
var
i: Integer;
begin
for i := 0 to Length(Value) - 1 do
Result := Result + Chr(Ord(Value[i]))
end;
I'm using Delphi 2007
If I understand you correctly I would replace the array with a set and use an enum without explicit values, like so:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TStatus = (fsNormal, fsEditedOnScreen, fsMissing, fsEstimated, fsSuspect,
fsSuspectFromOnScreen, fsSuspectMissing, fsSuspectEstimated);
TStatusSet = set of TStatus;
const
cStatusChars: array[TStatus] of Char = ('N', 'O', 'M', 'E', 's', 'o', 'm', 'e');
function CharToStatus(AChar: Char; out AStatus: TStatus): Boolean;
var
st: TStatus;
begin
for st := Low(TStatus) to High(TStatus) do
if cStatusChars[st] = AChar then
begin
AStatus := st;
Result := True;
Exit;
end;
Result := False;
end;
function StrToStatus(const Value: string): TStatusSet;
var
i: Integer;
st: TStatus;
begin
Result := [];
for i := 1 to Length(Value) do
if CharToStatus(Value[i], st) then
Include(Result, st);
end;
function StatusToStr(const Value: TStatusSet): string;
var
st: TStatus;
begin
for st in Value do
Result := Result + cStatusChars[st];
end;
var
StatusSet: TStatusSet;
begin
StatusSet := StrToStatus('EmO');
Writeln(StatusToStr(StatusSet));
Readln;
end.
First, I wonder why you save it as string instead of as integer.
The way you've done it, the only way to do it correctly would be to have a Case condition...
function CharToStatus(AChar : Char):TStatus;
begin
case AChar of
'N' : Result := fsNormal;
'O' : Result := fsEditedOnScreen;
'M' : Result := fsMissing;
'E' : Result := fsEstimated;
's' : Result := fsSuspect;
'o' : Result := fsSuspectFromOnScreen;
'm' : Result := fsSuspectMissing;
'e' : Result := fsSuspectEstimated;
else
//Manage error;
end;
end;
function StatusToChar(AStatus : TStatus) : char;
begin
Result := Char(AStatus);
end;
The expression x in [Low(TStatus)]..High(Tstatus)] won't work in this situation.
The reason for this is that Low(TStatus) = 'E', and High(TStatus) = 's'. Anything in-between would be considered valid. (i.e. 'Z' is in [Low(TStatus)]..High(Tstatus)])
The expression x in [Low(TStatus)]..High(Tstatus)] only work on type where there is no "hole" in the declaration. (Like those without explicit values, where the first element is 0, 2nd is 1, 3rd is 2... etc)
//EDIT
Ok.. thinking the problem a bit further, I don't see why you don't like the const array approach... Something like this would be a lot better.
type
TStatus = (fsNormal, fsEditedOnScreen,
fsMissing,fsEstimated,fsSuspect,
fsSuspectFromOnScreen,fsSuspectMissing ,
fsSuspectEstimated);
const
StatusValue : Array[TStatus] of Char = ('N','O','M','E','s','o','m','e');
function StatusValueToTStatus(C : Char) : TStatus;
var I : Integer;
begin
for I := Low(StatusValue) to High(StatusValue) do
begin
if StatusValue = C then
begin
Result := TStatus(I);
EXIT;
end;
end;
//Not found, Manage errors
end;