paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-04 10:58:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

Components: Reduce calls to UpperCase() and LowerCase(). Improves performance.

Browse Source 
git-svn-id: trunk@64506 -
This commit is contained in:
juha 2021-02-08 19:09:30 +00:00
parent 87ab5c4219
commit b53ad7ceed
41 changed files with 194 additions and 225 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
components/chmhelp/packages/idehelp/chmprog.pas
View File

@ -5,8 +5,9 @@ unit ChmProg;
interface
uses
Classes, SysUtils,
Dialogs, FileUtil, LazFileUtils, LazUTF8, LazLogger,
Classes, SysUtils, chmreader, chmFiftiMain,
Dialogs,
FileUtil, LazFileUtils, LazUTF8, LazLogger,
LazHelpIntf, HelpIntfs,
IDEHelpIntf, MacroIntf;
@ -21,7 +22,7 @@ type
private
FCHMSearchPath: string;
FDirectiveNodes: TFPList;
function SearchForDirective(ADirective: string;
function SearchForDirective(const ADirective: string;
var ListOfNodes: THelpNodeQueryList): Boolean;
procedure ClearDirectiveNodes;
public
@ -45,8 +46,6 @@ var
implementation
uses chmreader, chmFiftiMain;
procedure RegisterFPCDirectivesHelpDatabase;
begin
if not Assigned(FPCDirectivesHelpDatabase) then
@ -57,22 +56,19 @@ end;
{ TFPCDirectivesHelpDatabase }
function TFPCDirectivesHelpDatabase.SearchForDirective(ADirective: string;
function TFPCDirectivesHelpDatabase.SearchForDirective(const ADirective: string;
var ListOfNodes: THelpNodeQueryList): Boolean;
var
chm: TChmFileList;
fchm: TChmReader;
DocTitle, URL: string;
DocTitle, URL, Filename: string;
ms: TMemoryStream;
SearchReader: TChmSearchReader;
TitleResults: TChmWLCTopicArray;
i, k: Integer;
DirectiveNode: THelpNode;
Filename: String;
begin
ADirective := UpperCase(ADirective);
Result := False;
Filename:=FindCHMFile;
if Filename='' then exit;
@ -94,9 +90,10 @@ begin
for k := 0 to High(TitleResults) do
begin
URL := fchm.LookupTopicByID(TitleResults[k].TopicIndex, DocTitle);
i := Pos(ADirective, DocTitle);
if (i = 0) or (Length(DocTitle) >= i + Length(ADirective))
and (upCase(DocTitle[i + Length(ADirective)]) in ['A'..'Z','0'..'9']) then Continue;
i := PosI(ADirective, DocTitle);
if i = 0 then Continue;
if Length(DocTitle) = i+Length(ADirective)-1 then Continue;
if DocTitle[i+Length(ADirective)] in ['A'..'Z','a'..'z','0'..'9'] then Continue;
if (Length(URL) > 0) and (URL[1] = '/') then
Delete(URL, 1, 1);
if URL = '' then Continue;

2
components/datetimectrls/datetimepicker.pas
View File

@ -1034,7 +1034,7 @@ begin
AValue := TrimRight(AValue);
FMonthNames := AValue;
if UpperCase(AValue) = 'SHORT' then
if CompareText(AValue, 'SHORT') = 0 then
for I := Low(TMonthNameArray) to High(TMonthNameArray) do
FMonthNamesArray[I] := AnsiToUtf8(DefaultFormatSettings.ShortMonthNames[I])
else begin

21
components/datetimectrls/design/datetimepickerpropedit.pas
View File

@ -193,8 +193,10 @@ var
begin
OnActivate := nil;
B := False;
if Prop = 'MAXDATE' then DateTimePickerMax.SetFocus
else if Prop = 'MINDATE' then DateTimePickerMin.SetFocus
if CompareText(Prop, 'MAXDATE') = 0 then
DateTimePickerMax.SetFocus
else if CompareText(Prop, 'MINDATE') = 0 then
DateTimePickerMin.SetFocus
else begin
DateTimePicker1.SetFocus;
B := DateTimePicker1.NullInputAllowed;
@ -216,12 +218,12 @@ var
begin
if Assigned(Caller) then begin
CallerDateTimePicker := Caller;
Prop := UpperCase(PropertyName);
Prop := PropertyName;
BiDiMode := CallerDateTimePicker.BiDiMode;
Modified := False;
DateTimePicker1.Kind := dtkDateTime;
if UpperCase(PropertyType) = 'TTIME' then
if CompareText(PropertyType, 'TTIME') = 0 then
DateTimePicker1.SelectTime
else
DateTimePicker1.SelectDate;
@ -425,16 +427,14 @@ end;
function TDateTimePickerDateTimePropEditor.GetValue: string;
var
DT: TDateTime;
S: String;
begin
DT := TDateTime(GetFloatValue);
if IsNullDate(DT) then
Result := 'NULL'
else begin
S := UpperCase(GetPropType^.Name);
if S = 'TDATE' then
if CompareText(GetPropType^.Name, 'TDATE') = 0 then
Result := DateToStr(DT)
else if S = 'TTIME' then
else if CompareText(GetPropType^.Name, 'TTIME') = 0 then
Result := TimeToStr(DT)
else
Result := DateTimeToStr(DT);
@ -447,10 +447,9 @@ var
begin
S := Trim(Value);
if (S > '') and (UpCase(S[1]) <> 'N') then begin
S := UpperCase(GetPropType^.Name);
if S = 'TDATE' then
if CompareText(GetPropType^.Name, 'TDATE') = 0 then
SetFloatValue(StrToDate(Value))
else if S = 'TTIME' then
else if CompareText(GetPropType^.Name, 'TTIME') = 0 then
SetFloatValue(StrToTime(Value))
else
inherited SetValue(Value);

15
components/debuggerintf/dbgintfdebuggerbase.pp
View File

@ -3441,14 +3441,11 @@ end;
function TWatches.Find(const AExpression: String): TWatch;
var
n: Integer;
S: String;
begin
S := UpperCase(AExpression);
for n := 0 to Count - 1 do
begin
Result := TWatch(GetItem(n));
if UpperCase(Result.Expression) = S
then Exit;
if CompareText(Result.Expression, AExpression) = 0 then Exit;
end;
Result := nil;
end;
@ -5012,14 +5009,11 @@ end;
function TBaseSignals.Find(const AName: String): TBaseSignal;
var
n: Integer;
S: String;
begin
S := UpperCase(AName);
for n := 0 to Count - 1 do
begin
Result := TBaseSignal(GetItem(n));
if UpperCase(Result.Name) = S
then Exit;
if CompareText(Result.Name, AName) = 0 then Exit;
end;
Result := nil;
end;
@ -5122,14 +5116,11 @@ end;
function TBaseExceptions.Find(const AName: String): TBaseException;
var
n: Integer;
S: String;
begin
S := UpperCase(AName);
for n := 0 to Count - 1 do
begin
Result := TBaseException(GetItem(n));
if UpperCase(Result.Name) = S
then Exit;
if CompareText(Result.Name, AName) = 0 then Exit;
end;
Result := nil;
end;

8
components/fpdebug/fpdbgclasses.pp
View File

@ -899,18 +899,18 @@ function TLibraryMap.GetLib(const AName: String; out ALib: TDbgLibrary;
var
Iterator: TMapIterator;
Lib: TDbgLibrary;
n: String;
s: String;
begin
Result := False;
Iterator := TMapIterator.Create(Self);
n := UpperCase(AName);
while not Iterator.EOM do
begin
Iterator.GetData(Lib);
if IsFullName then
Result := UpperCase(Lib.Name) = n
s := Lib.Name;
else
Result := UpperCase(ExtractFileName(Lib.Name)) = n;
s := ExtractFileName(Lib.Name);
Result := CompareText(s, AName) = 0;
if Result
then begin
ALib := Lib;

3
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -1059,7 +1059,8 @@ begin
then begin
if (n <> '') and (n[1] = '$') then // dwarf3 // TODO: make required in dwarf3
delete(n, 1, 1);
if (copy(n,1,4) = 'high') and (UpperCase(copy(n, 5, length(n))) = UpperCase(DbgSymbol.Name)) then begin
if (copy(n,1,4) = 'high')
and (CompareText(copy(n, 5, length(n)), DbgSymbol.Name) = 0) then begin
UpperBoundSym := TFpSymbolDwarf.CreateSubClass('', Info);
if UpperBoundSym <> nil then begin
val := UpperBoundSym.Value;

7
components/fpweb/fpwebhrefeditunit.pas
View File

@ -35,8 +35,9 @@ unit fpWebHREFEditUnit;
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
ButtonPanel, StdCtrls, Buttons;
Classes, SysUtils,
Forms, Controls, Graphics, Dialogs, ComCtrls, ButtonPanel, StdCtrls, Buttons,
FileUtil, LazStringUtils;
type
@ -136,7 +137,7 @@ begin
if LazarusIDE.ActiveProject.Files[i].IsPartOfProject then
begin
S:=LazarusIDE.ActiveProject.Files[i].Filename;
if Copy(UpperCase(ExtractFileExt(S)), 1, 4) = '.HTM' then
if LazStartsText('.HTM', ExtractFileExt(S)) then
cbHREF.Items.Add(S);
end;
end;

8
components/fpweb/fpwebnewhtmlfileunit.pas
View File

@ -143,18 +143,18 @@ end;
procedure TfpWebNewHTMLFileForm.FillLinks;
var
i:integer;
S, Ext:string;
S, Ext: string;
begin
if Assigned(LazarusIDE) and Assigned(LazarusIDE.ActiveProject) then
begin
for i:=0 to LazarusIDE.ActiveProject.FileCount - 1 do
begin
S:=LazarusIDE.ActiveProject.Files[i].Filename;
Ext:=UpperCase(ExtractFileExt(S));
if Ext = '.JS' then
Ext:=ExtractFileExt(S);
if CompareText(Ext, '.JS') = 0 then
edtJS.Items.Add(S)
else
if Ext = '.CSS' then
if CompareText(Ext, '.CSS') = 0 then
edtCSS.Items.Add(S);
end;
end;

8
components/jcf2/Utils/JcfStringUtils.pas
View File

@ -112,7 +112,6 @@ function StrAfter(const SubStr, S: string): string;
function StrBefore(const SubStr, S: string): string;
function StrChopRight(const S: string; N: Integer): string;
function StrLastPos(const SubStr, S: string): Integer;
function StrIPos(const SubStr, S: string): integer;
function StrLeft(const S: string; Count: Integer): string;
function StrRestOf(const S: string; N: Integer ): string;
@ -327,13 +326,6 @@ begin
end;
end;
{ case-insensitive "pos" }
function StrIPos(const SubStr, S: string): integer;
begin
// simple and inneficient implmentation
Result := Pos(UpperCase(SubStr), UpperCase(s));
end;
function StrLeft(const S: string; Count: Integer): string;
begin
Result := Copy(S, 1, Count);

4
components/lazdebuggergdbmi/debugutils.pp
View File

@ -468,8 +468,8 @@ begin
gdb 7.7 and 7.8 fail to find members, if lowercased
Alternative prefix with "self." if gdb returns &"Type TCLASSXXXX has no component named EXPRESSION.\n"
*)
if (i<=l) and (Result[i] in ['a'..'z']) then
Result[i] := UpperCase(Result[i])[1];
if (i<=l) and (Result[i] in ['a'..'z']) then
Result[i] := UpCase(Result[i]);
inc(i);
end;
end;

28
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -2852,16 +2852,16 @@ begin
HadTimeout := HadTimeout and LastExecwasTimeOut;
if R.State <> dsError
then begin
if UpperCase(LeftStr(R.Values, 15)) = UpperCase('type = ^TOBJECT')
if LazStartsText('type = ^TOBJECT', R.Values)
then include(TargetInfo^.TargetFlags, tfClassIsPointer);
end;
R := CheckHasType('Exception', tfFlagHasTypeException);
HadTimeout := HadTimeout and LastExecwasTimeOut;
if R.State <> dsError
then begin
if LeftStr(R.Values, 17) = 'type = ^Exception'
if StartsStr('type = ^Exception', R.Values)
then include(TargetInfo^.TargetFlags, tfFlagMaybeDwarf3);
if UpperCase(LeftStr(R.Values, 17)) = UpperCase('type = ^EXCEPTION')
if LazStartsText('type = ^EXCEPTION', R.Values)
then include(TargetInfo^.TargetFlags, tfExceptionIsPointer);
end;
CheckHasType('Shortstring', tfFlagHasTypeShortstring);
@ -5942,9 +5942,9 @@ begin
DoSetMaxValueMemLimit();
DoSetAssemblerStyle();
if (FTheDebugger.FileName <> '') and (pos('READING SYMBOLS FROM', UpperCase(CmdResp)) < 1) then begin
if (FTheDebugger.FileName <> '') and (PosI('reading symbols from', CmdResp) < 1) then begin
ExecuteCommand('ptype TObject', [], R);
if pos('NO SYMBOL TABLE IS LOADED', UpperCase(FFullCmdReply)) > 0 then begin
if PosI('no symbol table is loaded', FFullCmdReply) > 0 then begin
ExecuteCommand('-file-exec-and-symbols %s',
[FTheDebugger.ConvertToGDBPath(FTheDebugger.FileName, cgptExeName)], R);
DoSetPascal; // TODO: check with ALL versions of gdb, if that value needs to be refreshed or not.
@ -7099,7 +7099,7 @@ var
// Did we just leave an SEH finally block?
if (FStepStartedInFinSub = sfsStepExited) and (FTheDebugger.FStoppedReason = srNone) then begin
if (UpperCase(FTheDebugger.FCurrentLocation.FuncName) <> '__FPC_SPECIFIC_HANDLER') and
if (CompareText(FTheDebugger.FCurrentLocation.FuncName, '__FPC_SPECIFIC_HANDLER') <> 0) and
(FTheDebugger.FCurrentLocation.SrcFile <> '')
then begin
DoEndStepping;
@ -13553,7 +13553,7 @@ var
end;
s := uppercase(AType.Fields[j].Name);
if uppercase(Payload) <> s
if CompareText(Payload, s) <> 0
then begin
debugln(DBGMI_STRUCT_PARSER, 'Field name does not match, expected "', AType.Fields[j].Name, '" but found "', Payload,'"');
Break;
@ -13585,7 +13585,7 @@ var
GDBParser.Free;
end;
procedure PutValuesInClass(const AType: TGDBType; ATextInfo: String);
procedure PutValuesInClass(AType: TGDBType; const ATextInfo: String);
var
//GDBParser: TGDBStringIterator;
//Payload: String;
@ -13629,10 +13629,10 @@ var
SkipSpaces;
end;
procedure ProcessAncestor(ATypeName: String);
procedure ProcessAncestor(const ATypeName: String);
var
HelpPtr, HelpPtr2: PChar;
NewName, NewVal, Sn, Sc: String;
NewName, NewVal: String;
i: Integer;
NewField: TDBGField;
begin
@ -13693,15 +13693,13 @@ var
NewVal := copy(HelpPtr, 1, HelpPtr2 + 1 - HelpPtr); // name of field
i := AType.Fields.Count - 1;
Sn := UpperCase(NewName);
Sc := UpperCase(ATypeName);
while (i >= 0)
and ( (uppercase(AType.Fields[i].Name) <> Sn)
or (uppercase(AType.Fields[i].ClassName) <> Sc) )
and ( (CompareText(AType.Fields[i].Name, NewName) <> 0)
or (CompareText(AType.Fields[i].ClassName, ATypeName) <> 0) )
do dec(i);
if i < 0 then begin
if (Sc <> 'TOBJECT') or (pos('VPTR', Sn) < 1) then begin
if (CompareText(ATypeName, 'tobject') <> 0) or (PosI('vptr', NewName) < 1) then begin
if not(defFullTypeInfo in FEvalFlags) then begin
NewField := TDBGField.Create(NewName, TGDBType.Create(skSimple, ''), flPublic, [], '');
AType.Fields.Add(NewField);

8
components/lazdebuggergdbmi/gdbtypeinfo.pp
View File

@ -1667,7 +1667,7 @@ begin
Alternative prefix with "self." if gdb returns &"Type TCLASSXXXX has no component named EXPRESSION.\n"
*)
if (CurPtr < EndPtr) and (CurPtr^ in ['a'..'z']) then
CurPtr^ := UpperCase(CurPtr^)[1];
CurPtr^ := UpCase(CurPtr^);
inc(CurPtr);
end;
if CurPtr = EndPtr then
@ -2006,13 +2006,11 @@ function TGDBPTypeRequestCache.IndexOf(AThreadId, AStackFrame: Integer;
ARequest: TGDBPTypeRequest): Integer;
var
e: TGDBPTypeRequestCacheEntry;
s: String;
HashVal: Integer;
begin
s := UpperCase(ARequest.Request);
// There are usually a couple of dozen entry total. Even if most are the same len the search will be quick
// Including stackframe, means nested procedures go in different lists.
HashVal := Length(s) mod (TGDBPTypeReqCacheListCount div 8) * 8
HashVal := Length(ARequest.Request) mod (TGDBPTypeReqCacheListCount div 8) * 8
+ AStackFrame mod 4 * 2
+ ord(ARequest.ReqType);
Result := -1;
@ -2022,7 +2020,7 @@ begin
while Result >= 0 do begin
e := TGDBPTypeRequestCacheEntry(FLists[HashVal][Result]);
if (e.ThreadId = AThreadId) and (e.StackFrame = AStackFrame) and
(e.Request.Request = s) and
(CompareText(e.Request.Request, ARequest.Request) = 0) and
(e.Request.ReqType = ARequest.ReqType)
then begin
Result := Result * TGDBPTypeReqCacheListCount + HashVal;

2
components/lazdebuggergdbmi/test/gdbmitestutils/testwatchutils.pas
View File

@ -502,7 +502,7 @@ begin
if HasTpInfo then begin
for i := 0 to Length(MemberTests) - 1 do begin
j := WV.TypeInfo.Fields.Count - 1;
while (j >= 0) and (uppercase(WV.TypeInfo.Fields[j].Name) <> UpperCase(MemberTests[i].Name)) do dec(j);
while (j >= 0) and (CompareText(WV.TypeInfo.Fields[j].Name, MemberTests[i].Name) <> 0) do dec(j);
TestTrue(Name + ' no members with name ' + MemberTests[i].Name,
(fTExpectNotFOund in MemberTests[i].Flgs) <> (j >= 0),
DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;

6
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -1738,7 +1738,7 @@ begin
if Instr is TX86AsmInstruction then begin
case TX86AsmInstruction(Instr).X86OpCode of
OPmov:
if UpperCase(TX86AsmInstruction(Instr).X86Instruction.Operand[2].Value) = 'RBP' then
if CompareText(TX86AsmInstruction(Instr).X86Instruction.Operand[2].Value, 'RBP') = 0 then
FFinState := fsMov;
OPcall:
if FFinState = fsMov then begin
@ -3170,7 +3170,7 @@ procedure TFpDebugExceptionStepping.ThreadProcessLoopCycle(
end;
sym := CurrentProcess.FindProcSymbol(CurrentThread.GetInstructionPointerRegisterValue);
r := (sym <> nil) and (UpperCase(sym.Name) <> '__FPC_SPECIFIC_HANDLER') and
r := (sym <> nil) and (CompareText(sym.Name, '__FPC_SPECIFIC_HANDLER') <> 0) and
(sym.FileName <> '');
sym.ReleaseReference;
if r then
@ -4541,7 +4541,7 @@ begin
if (P <> nil) and
( (P.Name = 'FPC_ASSERT') or (P.Name = 'fpc_assert') or
(P.Name = 'ASSERT') or (P.Name = 'assert') or
(UpperCase(copy(P.Name, 1, length(SYS_ASSERT_NAME))) = SYS_ASSERT_NAME) )
(CompareText(copy(P.Name, 1, length(SYS_ASSERT_NAME)), SYS_ASSERT_NAME) = 0) )
then begin
dec(f);
Result := CList[f].AnAddress - 1;

2
components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp
View File

@ -526,7 +526,7 @@ begin
assert(AContext <> nil, 'TFpGDBMIDbgMemReader.ReadRegister: AContext <> nil');
Reg := FDebugger.Registers.CurrentRegistersList[AContext.ThreadId, AContext.StackFrame];
for i := 0 to Reg.Count - 1 do
if UpperCase(Reg[i].Name) = rname then
if CompareText(Reg[i].Name, rname) = 0 then
begin
RegVObj := Reg[i].ValueObjFormat[rdDefault];
if RegVObj <> nil then

2
components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas
View File

@ -714,7 +714,7 @@ begin
end;
for i := 0 to Reg.Count - 1 do
if UpperCase(Reg[i].Name) = rname then
if CompareText(Reg[i].Name, rname) = 0 then
begin
RegVObj := Reg[i].ValueObjFormat[rdDefault];
if RegVObj <> nil then

4
components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas
View File

@ -2293,10 +2293,10 @@ begin
if TLldbDebuggerProperties(Debugger.GetProperties).SkipGDBDetection then
FGotLLDB := True
else
if StrContains(UpperCase(ALine), 'LLDB') then
if PosI('LLDB', ALine) > 0 then
FGotLLDB := True
else
if StrContains(UpperCase(ALine), '(GDB)') then
if PosI('(GDB)', ALine) > 0 then
Debugger.SetErrorState('GDB detected', 'The external debugger identified itself as GDB. The IDE expected LLDB.');
end;

7
components/lazdebuggers/lazdebuggerlldb/lldbhelper.pas
View File

@ -60,10 +60,9 @@ begin
end;
end;
function StrStartsWith(AString, AStart: string; ACheckStartNotEmpty: Boolean
): Boolean;
function StrStartsWith(AString, AStart: string; ACheckStartNotEmpty: Boolean): Boolean;
begin
Result := ( (not ACheckStartNotEmpty) or (AStart <> '') ) and (LeftStr(AString, Length(AStart)) = AStart);
Result := (not ACheckStartNotEmpty or (AStart <> '')) and StartsStr(AStart, AString);
end;
function StrContains(AString, AFind: string): Boolean;
@ -92,7 +91,7 @@ begin
end;
SetLength(AGapsContent, FindLen - 1);
Result := StrStartsWith(AString, AFind[0]);
Result := StartsStr(AFind[0], AString);
if not Result then
exit;
Delete(AString, 1, Length(AFind[0]));

10
components/lazdebuggers/lazdebuggerlldb/lldbinstructions.pas
View File

@ -20,7 +20,7 @@ interface
uses
SysUtils, Classes, strutils,
// LazUtils
LazLoggerBase,
LazLoggerBase, LazStringUtils,
// DebuggerIntf
DbgIntfDebuggerBase, DbgIntfBaseTypes,
// CmdLineDebuggerBase
@ -453,7 +453,7 @@ begin
end;
FBreakId:= i;
if StrContains(found[1], 'pending') then
if Pos('pending', found[1]) > 0 then
FState := vsPending
else
if StrMatches(found[1], ['', ' locations'], found2) then begin
@ -580,9 +580,9 @@ var
s: String;
begin
Result := False;
if LeftStr(AData, 7) = 'error: ' then begin
s := MaskQuotedText(LowerCase(AData));
if (StrContains(s, 'debug map time') and StrContains(s, 'file will be ignored'))
if StartsStr('error: ', AData) then begin
s := MaskQuotedText(AData);
if (PosI('debug map time', s) > 0) and (PosI('file will be ignored', s) > 0)
then begin
FDwarfLoadErrors := FDwarfLoadErrors + AData + LineEnding;
exit;

2
components/lazdebuggers/lazdebugtestbase/testcommonsources.pas
View File

@ -53,7 +53,7 @@ function GetCommonSourceFor(AName: String): TCommonSource;
var
i: Integer;
begin
if UpperCase(AName) = UpperCase(BlockRecurseName) then
if CompareText(AName, BlockRecurseName) = 0 then
raise Exception.Create('BlockRecurseName');
i := CommonSources.IndexOf(AName);
if i >= 0 then

2
components/lazdebuggers/lazdebugtestbase/testdbgtestsuites.pas
View File

@ -352,7 +352,7 @@ begin
if ACaseSense then
Result := Got = Expected
else
Result := UpperCase(Got) = UpperCase(Expected);
Result := CompareText(Got, Expected) = 0;
Name := Name + ': Expected "'+Expected+'", Got "'+Got+'"';
if Result
then AddTestSuccess(Name, MinDbgVers, MinFpcVers, AIgnoreReason)

11
components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas
View File

@ -1438,13 +1438,13 @@ begin
while i > 1 do begin
s := copy(ExpTpName, 1, i-1);
delete(ExpTpName, i, i);
if UpperCase(s) = UpperCase(WtchTpName) then begin
if CompareText(s, WtchTpName) = 0 then begin
Result := TestEquals('TypeName'+n, s, WtchTpName, EqIgnoreCase, AContext, AnIgnoreRsn);
exit;
end;
i := pos('|', ExpTpName);
end;
if (ExpTpName <> '') and (UpperCase(ExpTpName) = UpperCase(WtchTpName)) then begin
if (ExpTpName <> '') and (CompareText(ExpTpName, WtchTpName) = 0) then begin
Result := TestEquals('TypeName'+n, ExpTpName, WtchTpName, EqIgnoreCase, AContext, AnIgnoreRsn);
exit;
end;
@ -2086,10 +2086,13 @@ begin
end;
procedure TWatchExpectationList.AddTypeNameAlias(ATypeName, AnAliases: String);
var
S: String;
begin
ATypeName := UpperCase(ATypeName);
if FTypeNameAliases.Values[ATypeName] <> '' then
AnAliases := FTypeNameAliases.Values[ATypeName] + '|' + FTypeNameAliases.Values[ATypeName];
S := FTypeNameAliases.Values[ATypeName];
if S <> '' then
AnAliases := S + '|' + S;
FTypeNameAliases.Values[ATypeName] := AnAliases;
end;

12
components/lazreport/source/addons/SqlDB/lr_sqlquery.pas
View File

@ -18,7 +18,7 @@ type
{ TQueryParamList }
TQueryParamList = class(TFPObjectList)
function ParamByName(AParamName:string):TQueryParam;
function ParamByName(const AParamName: string): TQueryParam;
function Add(AParamType:TFieldType; const AParamName, AParamValue:string):TQueryParam;
end;
@ -112,15 +112,14 @@ end;
{ TQueryParamList }
function TQueryParamList.ParamByName(AParamName: string): TQueryParam;
function TQueryParamList.ParamByName(const AParamName: string): TQueryParam;
var
i:integer;
begin
Result:=nil;
AParamName:=UpperCase(AParamName);
for i:=0 to Count - 1 do
begin
if UpperCase(TQueryParam(Items[i]).ParamName) = AParamName then
if CompareText(TQueryParam(Items[i]).ParamName, AParamName) = 0 then
begin
Result:=TQueryParam(Items[i]);
exit;
@ -421,15 +420,14 @@ begin
inherited Destroy;
end;
function StrToFieldType(AStrTypeName:string):TFieldType;
function StrToFieldType(const AStrTypeName: string): TFieldType;
var
i:TFieldType;
begin
Result:=ftUnknown;
AStrTypeName:=UpperCase(AStrTypeName);
for i in TFieldType do
begin
if UpperCase(Fieldtypenames[i]) = AStrTypeName then
if CompareText(Fieldtypenames[i], AStrTypeName) = 0 then
begin
Result:=i;
exit;

12
components/lazreport/source/addons/ZeosDB/lr_db_zeos.pas
View File

@ -23,7 +23,7 @@ type
{ TQueryParamList }
TQueryParamList = class(TFPObjectList)
function ParamByName(AParamName:string):TQueryParam;
function ParamByName(const AParamName:string):TQueryParam;
function Add(AParamType:TFieldType; const AParamName, AParamValue:string):TQueryParam;
end;
@ -127,15 +127,14 @@ end;
{ TQueryParamList }
function TQueryParamList.ParamByName(AParamName: string): TQueryParam;
function TQueryParamList.ParamByName(const AParamName: string): TQueryParam;
var
i:integer;
begin
Result:=nil;
AParamName:=UpperCase(AParamName);
for i:=0 to Count - 1 do
begin
if UpperCase(TQueryParam(Items[i]).ParamName) = AParamName then
if CompareText(TQueryParam(Items[i]).ParamName), AParamName) = 0 then
begin
Result:=TQueryParam(Items[i]);
exit;
@ -465,15 +464,14 @@ begin
inherited Destroy;
end;
function StrToFieldType(AStrTypeName:string):TFieldType;
function StrToFieldType(const AStrTypeName:string):TFieldType;
var
i:TFieldType;
begin
Result:=ftUnknown;
AStrTypeName:=UpperCase(AStrTypeName);
for i in TFieldType do
begin
if UpperCase(Fieldtypenames[i]) = AStrTypeName then
if CompareText(Fieldtypenames[i], AStrTypeName) = 0 then
begin
Result:=i;
exit;

10
components/lazreport/source/addons/lrFclPDFExport/lr_e_fclpdf.pas
View File

@ -40,7 +40,10 @@ unit lr_e_fclpdf;
interface
uses
Classes, SysUtils, LR_Class, LR_ChBox, LR_BarC, LR_Shape, LR_RRect, fpPDF, Graphics, fpTTF;
Classes, SysUtils,
Graphics,
LazStringUtils,
LR_Class, LR_ChBox, LR_BarC, LR_Shape, LR_RRect, fpPDF, fpTTF;
type
TExportFonts = class;
@ -414,11 +417,10 @@ var
begin
DrawRectView(View);
S:=UpperCase(TfrMemoView(View).URLInfo);
if (S <> '') and ((Copy(S, 1, 7) = 'HTTP://') or (Copy(S, 1, 8) = 'HTTPS://')) then
S:=TfrMemoView(View).URLInfo;
if LazStartsText('HTTP://', S) or LazStartsText('HTTPS://', S) then
WriteURL(View.Left, View.Top, View.Width, View.Height, TfrMemoView(View).URLInfo);
//prepare font
FCurFont:=FFontItems.AddItem(View.Font.Name, View.Font.Style);
if Assigned(FCurFont) then

9
components/lazreport/source/addons/lrspreadsheetexport/lr_exportmatrix.pas
View File

@ -38,7 +38,10 @@ unit LR_ExportMatrix;
interface
uses
Classes, SysUtils, LR_Class, Graphics;
Classes, SysUtils,
Graphics,
LazStringUtils,
LR_Class;
type
@ -289,8 +292,8 @@ begin
FLayout:=TfrMemoView(AObj).Layout;
FWordWrap:=TfrMemoView(AObj).WordWrap;
//http://www.lazarus-ide.org/
S:=UpperCase(TfrMemoView(AObj).URLInfo);
if (S <> '') and ((Copy(S, 1, 7) = 'HTTP://') or (Copy(S, 1, 8) = 'HTTPS://')) then
S:=TfrMemoView(AObj).URLInfo;
if LazStartsText('HTTP://', S) or LazStartsText('HTTPS://', S) then
URLInfo:=TfrMemoView(AObj).URLInfo;
end
else

59
components/lazreport/source/lr_class.pas
View File

@ -901,7 +901,7 @@ type
procedure Clear;
procedure Delete(Index: Integer);
function FindObjectByID(ID: Integer): Integer;
function FindObject(aName: String): TfrObject;
function FindObject(const aName: String): TfrObject;
function FindRTObject(const aName: String): TfrObject;
procedure ChangePaper(ASize, AWidth, AHeight: Integer; AOr: TPrinterOrientation);
procedure ShowBandByName(const s: String);
@ -1009,7 +1009,7 @@ type
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String);
procedure SaveToStream(Stream: TStream);
procedure SavetoXML(XML: TLrXMLConfig; const Path: String);
function PageByName(APageName:string):TfrPage;
function PageByName(const APageName: string): TfrPage;
property Pages[Index: Integer]: TfrPage read GetPages; default;
property Count: Integer read GetCount;
@ -1221,7 +1221,7 @@ type
procedure SetScript(AValue: TfrScriptStrings);
procedure SetVars(Value: TStrings);
procedure ClearAttribs;
function FindObjectByName(AName:string):TfrObject;
function FindObjectByName(AName: string): TfrObject;
procedure ExecScript;
procedure CheckFileExists(FName: string);
protected
@ -1260,7 +1260,7 @@ type
function FindVariable(Variable: String): Integer;
procedure GetVariableValue(const s: String; var aValue: Variant);
procedure GetVarList(CatNo: Integer; List: TStrings);
procedure GetIntrpValue(AName: String; var AValue: Variant);
procedure GetIntrpValue(const AName: String; var AValue: Variant);
procedure GetCategoryList(List: TStrings);
function FindObject(const aName: String): TfrObject;
// internal events used through report building
@ -7606,23 +7606,17 @@ begin
end;
end;
function TfrPage.FindObject(aName: String): TfrObject;
function TfrPage.FindObject(const aName: String): TfrObject;
var
i: Integer;
begin
Result := nil;
aName:=UpperCase(aName);
if UpperCase(Name) = aName then
if CompareText(Name, aName) = 0 then
Result:=Self
else
for i := 0 to Objects.Count - 1 do
begin
if UpperCase(TfrObject(Objects[i]).Name) = aName then
begin
Result :=TfrObject(Objects[i]);
Exit;
end;
end;
if CompareText(TfrObject(Objects[i]).Name, aName) = 0 then
Exit(TfrObject(Objects[i]));
end;
function TfrPage.FindRTObject(const aName: String): TfrObject;
@ -9036,7 +9030,7 @@ begin
if b = gtAddIn then
begin
s := ReadString(Stream);
if UpperCase(s) = 'TFRFRAMEDMEMOVIEW' then
if CompareText(s, 'TFRFRAMEDMEMOVIEW') = 0 then
AddObject(gtMemo, '')
else
AddObject(gtAddIn, s);
@ -9044,7 +9038,7 @@ begin
else
AddObject(b, '');
t.LoadFromStream(Stream);
if UpperCase(s) = 'TFRFRAMEDMEMOVIEW' then
if CompareText(s, 'TFRFRAMEDMEMOVIEW') = 0 then
Stream.Read({%H-}buf[1], 8);
end;
end;
@ -9094,7 +9088,7 @@ begin
clname := XML.GetValue(aSubPath+'ClassName/Value', 'TFRVIEW'); // TODO: Check default
if aTyp=gtAddin then
begin
if UpperCase(clname)='TFRFRAMEDMEMOVIEW' then
if CompareText(clname,'TFRFRAMEDMEMOVIEW') = 0 then
addObject(Pages[i], gtMemo, '')
else
addObject(Pages[i], gtAddin, clName)
@ -9192,18 +9186,14 @@ begin
end;
end;
function TfrPages.PageByName(APageName: string): TfrPage;
function TfrPages.PageByName(const APageName: string): TfrPage;
var
i:integer;
begin
APageName:=UpperCase(APageName);
Result:=nil;
for i:=0 to FPages.Count - 1 do
if APageName = UpperCase(TfrPage(FPages[i]).Name) then
begin
Result:=TfrPage(FPages[i]);
exit;
end;
if CompareText(APageName, TfrPage(FPages[i]).Name) = 0 then
Exit(TfrPage(FPages[i]));
end;
{-----------------------------------------------------------------------}
@ -10460,7 +10450,7 @@ begin
for i:=0 to CurReport.Pages.Count - 1 do
begin
Page := CurReport.Pages[i];
if UpperCase(Page.Name) = ObjName then
if CompareText(Page.Name, ObjName) = 0 then
begin
// PageName.ObjName.Method
Obj:=Page;
@ -10470,7 +10460,7 @@ begin
ObjName:=Copy2SymbDel(Method, '.');
for j:=0 to Page.Objects.Count - 1 do
begin
if UpperCase(TfrObject(Page.Objects[j]).Name) = ObjName then
if CompareText(TfrObject(Page.Objects[j]).Name, ObjName) = 0 then
begin
Obj:=TfrObject(Page.Objects[j]);
break;
@ -10484,7 +10474,7 @@ begin
begin
for j:=0 to Page.Objects.Count - 1 do
begin
if UpperCase(TfrObject(Page.Objects[j]).Name) = ObjName then
if CompareText(TfrObject(Page.Objects[j]).Name, ObjName) = 0 then
begin
Obj:=TfrObject(Page.Objects[j]);
break;
@ -11948,7 +11938,6 @@ var
APgName:string;
Pg:TfrPage;
begin
AName:=UpperCase(AName);
Result:=nil;
if (Pos('.', AName)>0) then
begin
@ -12115,7 +12104,7 @@ begin
end;
end;
procedure TfrReport.GetIntrpValue(AName: String; var AValue: Variant);
procedure TfrReport.GetIntrpValue(const AName: String; var AValue: Variant);
var
t: TfrObject;
PropName: String;
@ -12206,22 +12195,22 @@ begin
if IdentToColor(AName, FColorVal) then
AValue := FColorVal
else
if UpperCase(AName) = 'MROK' then //try std ModalResult values
if CompareText(AName, 'MROK') = 0 then //try std ModalResult values
AValue := mrOk
else
if UpperCase(AName) = 'MRCANCEL' then //try std ModalResult values
if CompareText(AName, 'MRCANCEL') = 0 then //try std ModalResult values
AValue := mrCancel
else
if (UpperCase(AName) = 'FINALPASS') and Assigned(CurReport) then
if (CompareText(AName, 'FINALPASS') = 0) and Assigned(CurReport) then
AValue := CurReport.FinalPass
else
if (UpperCase(AName) = 'CURY') and Assigned(CurPage) then
if (CompareText(AName, 'CURY') = 0) and Assigned(CurPage) then
AValue := CurPage.CurY
else
if (UpperCase(AName) = 'PAGEHEIGHT') and Assigned(CurPage) then
if (CompareText(AName, 'PAGEHEIGHT') = 0) and Assigned(CurPage) then
AValue := CurPage.Height
else
if (UpperCase(AName) = 'PAGEWIDTH') and Assigned(CurPage) then
if (CompareText(AName, 'PAGEWIDTH') = 0) and Assigned(CurPage) then
AValue := CurPage.Width;
end;
end;

28
components/lazreport/source/lr_pars.pas
View File

@ -267,15 +267,14 @@ begin
end
else if s[k] = '(' then
begin
s1 := UpperCase(s1);
Get3Parameters(s, k, s2, s3, s4);
if s1 = 'COPY' then
if CompareText(s1, 'COPY') = 0 then
begin
ci := StrToInt(Calc(s3));
cn := StrToInt(Calc(s4));
nm[st] := UTF8Copy(Calc(s2), ci, cn);
end
else if s1 = 'IF' then
else if CompareText(s1, 'IF') = 0 then
begin
vCalc := Calc(S2);
if VarIsEmpty(vCalc) or varIsNull(vCalc) then
@ -296,9 +295,9 @@ begin
DebugLnExit('TfrParser.CalcOPZ IF <- Res=%s',[string(nm[st])]);
{$ENDIF}
end
else if s1 = 'STRTODATE' then
else if CompareText(s1, 'STRTODATE') = 0 then
nm[st] := StrToDate(Calc(s2))
else if s1 = 'STRTOTIME' then
else if CompareText(s1, 'STRTOTIME') = 0 then
nm[st] := StrToTime(Calc(s2))
else if Assigned(FOnFunction) then
begin
@ -409,7 +408,7 @@ label 1;
var
i, i1, j, p: Integer;
stack: String;
res, s1, s2, s3, s4: String;
res, s2, s3, s4: String;
vr: Boolean;
c: Char;
@ -535,50 +534,49 @@ begin
res := res + s2 + ' '
else
begin
s1 := UpperCase(s2);
if s1 = 'INT' then
if CompareText(s2, 'INT') = 0 then
begin
s[i - 1] := ttInt;
Dec(i);
goto 1;
end
else if s1 = 'FRAC' then
else if CompareText(s2, 'FRAC') = 0 then
begin
s[i - 1] := ttFrac;
Dec(i);
goto 1;
end
else if s1 = 'ROUND' then
else if CompareText(s2, 'ROUND') = 0 then
begin
s[i - 1] := ttRound;
Dec(i);
goto 1;
end
else if s1 = 'OR' then
else if CompareText(s2, 'OR') = 0 then
begin
s[i - 1] := ttOr;
Dec(i);
goto 1;
end
else if s1 = 'AND' then
else if CompareText(s2, 'AND') = 0 then
begin
s[i - 1] := ttAnd;
Dec(i);
goto 1;
end
else if s1 = 'NOT' then
else if CompareText(s2, 'NOT') = 0 then
begin
s[i - 1] := ttNot;
Dec(i);
goto 1;
end
else if s1 = 'STR' then
else if CompareText(s2, 'STR') = 0 then
begin
s[i - 1] := ttStr;
Dec(i);
goto 1;
end
else if s1 = 'MOD' then
else if CompareText(s2, 'MOD') = 0 then
begin
s[i - 1] := ttMod;
Dec(i);

2
components/lazreport/source/lr_utils.pas
View File

@ -712,7 +712,7 @@ begin
begin
with CustomForms[i] do
begin
if (UpperCase(ClassName)='TDATAMODULEFORM') then
if CompareText(ClassName,'TDATAMODULEFORM') = 0 then
for j := 0 to ComponentCount - 1 do
begin
if (Components[j] is TDataModule) then

8
components/leakview/leakinfo.pas
View File

@ -11,7 +11,7 @@ uses
// CodeTools
CodeToolManager, CodeCache,
// LazUtils
FileUtil, LazFileUtils, LazClasses, LazLoggerBase,
FileUtil, LazFileUtils, LazStringUtils, LazClasses, LazLoggerBase,
// IDEIntf
TextTools,
// LeakView
@ -339,7 +339,7 @@ begin
if CaseSensetive then
Result := Pos(SubStr, Trc[TrcIndex])>0
else // slow?
Result := Pos(UpperCase(SubStr), UpperCase(Trc[TrcIndex]))>0;
Result := PosI(SubStr, Trc[TrcIndex])>0;
end;
function THeapTrcInfo.IsTraceLine(const Idx: Integer;
@ -437,8 +437,8 @@ begin
i := 1;
while (i < length(SubStr)) and (SubStr[i] in [' ', #9, '#', '~', '"', '''']) do inc(i);
Result := (pos(UpperCase(CallTracePrefix), UpperCase(SubStr)) = i) or
(pos(UpperCase(RawTracePrefix), UpperCase(SubStr)) = i);
Result := (PosI(CallTracePrefix, SubStr) = i) or
(PosI(RawTracePrefix, SubStr) = i);
end;
function THeapTrcInfo.TrcNumberAfter(var Num: Int64; const AfterSub: string): Boolean;

6
components/messagecomposer/messagecomposer.pas
View File

@ -525,11 +525,11 @@ begin
Panel2.Visible := false;
ListParams := TStringList.Create;
strtmp := UpperCase(MsgMemo.Lines.Text);
strtmp := MsgMemo.Lines.Text;
indx := pos('%', strtmp);
while (indx>0)and(indx<Length(strtmp)) do begin
chrtmp := strtmp[indx+1];
while (indx>0) and (indx<Length(strtmp)) do begin
chrtmp := UpCase(strtmp[indx+1]);
if chrtmp in FormatParams then
ListParams.Add('%'+chrtmp);
Delete(strtmp, indx, 1);

2
components/mpaslex/mpaslex.pp
View File

@ -282,7 +282,7 @@ begin
'_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I]:=True;
else Identifiers[I]:=False;
end;
J:=UpperCase(I)[1];
J:=UpCase(I);
Case I of
'a'..'z', 'A'..'Z', '_': mHashTable[I]:=Ord(J)-64;
else mHashTable[Char(I)]:=0;

14
components/sparta/smartformeditor/source/sparta_componentpalette.pas
View File

@ -17,14 +17,18 @@ unit sparta_ComponentPalette;
interface
uses
Forms, Classes, SysUtils, Controls, ComCtrls, ComponentReg, ExtCtrls, Buttons,
Math, LazIDEIntf, PropEdits, LResources, LCLType, Graphics,
Forms, Classes, SysUtils, Math,
// LCL
Controls, ComCtrls, ExtCtrls, Buttons, LResources, LCLType, Graphics,
// LazUtils
LazStringUtils,
{$IF FPC_FULLVERSION>=30200}
Generics.Collections,
{$ELSE}
sparta_Generics.Collections,
{$ENDIF}
FormEditingIntf, IDEImagesIntf;
// IdeIntf
ComponentReg, LazIDEIntf, PropEdits, FormEditingIntf, IDEImagesIntf;
type
@ -225,7 +229,6 @@ var
LPComponents: TPanel;
LButtons: TList<TControl>;
LVisibleButtons: Integer;
LCompName: string;
LSearchResult: TTabSheet;
procedure AddButton(AButton: TSpeedButton);
@ -279,8 +282,7 @@ begin
for j := 0 to LPComponents.ControlCount - 1 do
begin
LCtrl := LPComponents.Controls[j];
LCompName := UpperCase(TRegisteredComponent(LCtrl.Tag).ComponentClass.ClassName);
if Pos(FFilter, LCompName) > 0 then
if PosI(FFilter, TRegisteredComponent(LCtrl.Tag).ComponentClass.ClassName) > 0 then
begin
LButtons.Add(LCtrl);
LCtrl.Visible := True;

2
components/synedit/synedithighlighter.pp
View File

@ -1081,7 +1081,7 @@ const
function IsTrue(value: string): boolean;
begin
Result := not ((UpperCase(value) = 'FALSE') or (value = '0'));
Result := not ((CompareText(value,'FALSE') = 0) or (value = '0'));
end; { IsTrue }
begin

4
components/synedit/syneditsearch.pp
View File

@ -145,8 +145,8 @@ procedure MakeCompTable;
var
I: Char;
begin
for I := #0 to #255 do CompTableSensitive[I] := ord(I);
for I := #0 to #255 do CompTableNoneSensitive[I] := ord(uppercase(I)[1]);
for I := #0 to #255 do CompTableSensitive[I] := Ord(I);
for I := #0 to #255 do CompTableNoneSensitive[I] := Ord(UpCase(I));
end;
function GetLineCountOfString(const aText: string): integer;

1
components/synedit/synhighlighterphp.pas
View File

@ -237,7 +237,6 @@ begin
'_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I] := True;
else Identifiers[I] := False;
end;
// J := UpperCase(I)[1];
J := UpCase(I);
Case I in ['_', 'A'..'Z', 'a'..'z'] of
True: mHashTable[I] := Ord(J) - 64

2
components/turbopower_ipro/ipcss.inc
View File

@ -513,7 +513,7 @@ end;
function SizePxFromString(S: String): Integer;
begin
S := Copy(S, 1, Pos('PX', UpperCase(S)) - 1);
S := Copy(S, 1, PosI('PX',S)-1);
Result := StrToIntDef(S, 0);
end;

16
components/turbopower_ipro/ipfilebroker.pas
View File

@ -31,8 +31,10 @@ unit Ipfilebroker;
interface
uses Classes, SysUtils, LResources, Graphics, LCLProc, LazFileUtils, LazUTF8,
ipconst, iputils, iphtml, ipmsg;
uses
Classes, SysUtils,
LResources, Graphics, LazFileUtils, LazStringUtils, LazUTF8,
ipconst, iputils, iphtml, ipmsg;
const
IP_DEFAULT_SCHEME : string = 'HTTP';
@ -290,9 +292,9 @@ begin
IpParseURL(FN, FileAddrRec);
FN := NetToDosPath(FileAddrRec.Path);
//DebugLn('TIpFileDataProvider.CanHandle FN="'+FN+'"');
ContentType := UpperCase(GetLocalContent(FN));
Result := (FileExistsUTF8(FN)) and ((Pos('TEXT/HTML', ContentType) > 0) or
(Pos('IMAGE/', ContentType) > 0));
ContentType := GetLocalContent(FN);
Result := FileExistsUTF8(FN) and ((PosI('TEXT/HTML', ContentType) > 0)
or (PosI('IMAGE/', ContentType) > 0));
Finalize(FileAddrRec);
end;
@ -353,8 +355,8 @@ begin
Picture := nil;
IpParseURL(URL, FileAddrRec);
FN := NetToDosPath(FileAddrRec.Path);
Content := UpperCase(GetLocalContent(FN));
if Pos('IMAGE/', Content) > 0 then begin
Content := GetLocalContent(FN);
if PosI('IMAGE/', Content) > 0 then begin
try
Picture := TPicture.Create;
Picture.LoadFromFile(FN);

7
components/turbopower_ipro/iphtml.pas
View File

@ -53,7 +53,7 @@ uses
//MemCheck,
Types, contnrs,
LCLType, GraphType, LCLProc, LCLIntf, LResources, LMessages, LCLMemManager,
Translations, FileUtil, LConvEncoding, LazUTF8, AvgLvlTree,
Translations, FileUtil, LazStringUtils, LConvEncoding, LazUTF8, AvgLvlTree,
IpHtmlTabList,
Messages, SysUtils, Classes, Graphics,
{$IFDEF UseGifImageUnit} //TODO all of this units not exists
@ -4388,7 +4388,6 @@ begin
PropPath := trim(PropPath);
if PropPath = '' then
Exit;
PropPath := UpperCase(PropPath);
if C.ClassInfo <> nil then begin
LCount := GetPropList(C.ClassInfo, tkProperties, nil);
LSize := LCount * SizeOf(Pointer);
@ -4401,14 +4400,14 @@ begin
J := pos('.', PropPath);
if J <> 0 then begin
SubPropPath := copy(PropPath, 1, J - 1);
if SubPropPath = UpperCase(PList^[I]^.Name) then begin
if CompareText(SubPropPath, PList^[I]^.Name) = 0 then begin
O := TObject(GetOrdProp(C, PList^[I]));
SetPropertyValue(O, copy(PropPath, J + 1, MAXINT), NewValue);
Exit;
end;
end;
end else begin
if PropPath = UpperCase(PList^[I]^.Name) then begin
if CompareText(PropPath, PList^[I]^.Name) = 0 then begin
SetPropertyValueLow(PList^[I], C, NewValue);
Exit;
end;

21
components/turbopower_ipro/ipmsg.pas
View File

@ -1524,19 +1524,19 @@ end;
function TIpMimeEntity.DecodeContentTransferEncoding(const aEncoding : string) :
TIpMimeEncodingMethod;
begin
if (UpperCase(aEncoding) = UpperCase(str7Bit)) then
if CompareText(aEncoding, str7Bit) = 0 then
Result := em7bit
else if (UpperCase(aEncoding) = UpperCase(str8Bit)) then
else if CompareText(aEncoding, str8Bit) = 0 then
Result := em8bit
else if (UpperCase(aEncoding) = UpperCase(strBase64)) then
else if CompareText(aEncoding, strBase64) = 0 then
Result := emBase64
else if (UpperCase(aEncoding) = UpperCase(strBinary)) then
else if CompareText(aEncoding, strBinary) = 0 then
Result := emBinary
else if (UpperCase(aEncoding) = UpperCase(strBinHex)) then
else if CompareText(aEncoding, strBinHex) = 0 then
Result := emBinHex
else if (UpperCase(aEncoding) = UpperCase(strQuoted)) then
else if CompareText(aEncoding, strQuoted) = 0 then
Result := emQuoted
else if (UpperCase(aEncoding) = UpperCase(strUUEncode)) then
else if CompareText(aEncoding, strUUEncode) = 0 then
Result := emUUEncode
else
Result := emUnknown;
@ -2529,10 +2529,9 @@ begin
WS1 := TMemoryStream.Create;
try
{ start with file name }
if (Length(aFileName) < MaxLine) then
HeaderFileName := UpperCase(ExtractFileName(aFileName))
else
HeaderFileName := Copy(UpperCase(ExtractFileName(aFileName)), 1, MaxLine);
HeaderFileName := UpperCase(ExtractFileName(aFileName));
if (Length(aFileName) >= MaxLine) then
SetLength(HeaderFileName, MaxLine);
WS1.Write(HeaderFileName, Length(HeaderFileName) + 1);
{ build rest of file header and header CRC and add to working stream }

21
components/turbopower_ipro/iputils.pas
View File

@ -35,8 +35,9 @@ unit IpUtils;
interface
uses
SysUtils, Classes, Controls, Registry, ComCtrls,
LCLType, GraphType, LCLIntf, LMessages, LazFileUtils, LCLProc;
SysUtils, Classes, Registry,
LCLType, LCLIntf, LMessages, Controls, ComCtrls,
GraphType, LazFileUtils, LazStringUtils;
const
InternetProfessionalVersion = 1.15;
@ -1717,7 +1718,7 @@ begin
else
Port := ':' + OldAddrRec.Port;
if UpperCase(NewAddrRec.Scheme) = 'FILE' then begin
if CompareText(NewAddrRec.Scheme, 'FILE') = 0 then begin
{ New is a local file }
Result := NewAddrRec.Scheme + '://' + NewAddrRec.Path;
end else if NewAddrRec.Scheme <> '' then begin
@ -1731,7 +1732,7 @@ begin
Result := Result + NewURL; { just append }
end else if (NewAddrRec.Scheme = '') and (NewURL[1] <> '.') then begin
{ New is probably a direct path off the current path }
if UpperCase(OldAddrRec.Scheme) = 'FILE' then begin
if CompareText(OldAddrRec.Scheme, 'FILE') = 0 then begin
Path := ExtractFilePath(OldAddrRec.Path);
Result := Scheme + Path;
end
@ -1978,7 +1979,7 @@ function MonStrToInt(MonStr : string) : Integer;
var
P : Integer;
begin
P := Pos(UpperCase(MonStr), MonthString);
P := PosI(MonStr, MonthString);
if P > 0 then
Result := (P div 9) + 1
else
@ -2421,12 +2422,12 @@ begin
end;
' ' : begin
if UpperCase (TimeZone) = 'AM' then begin
if CompareText(TimeZone, 'AM') = 0 then begin
AMPM := True;
PM := False;
State := IdTimeZoneAlpha;
TimeZone := '';
end else if UpperCase (TimeZone) = 'PM' then begin
end else if CompareText(TimeZone, 'PM') = 0 then begin
AMPM := True;
PM := True;
State := IdTimeZoneAlpha;
@ -2512,11 +2513,11 @@ begin
end;
if State = idTimeZoneAlpha then begin
if UpperCase (TimeZone) = 'AM' then begin
if CompareText(TimeZone, 'AM') = 0 then begin
AMPM := True;
PM := False;
TimeZone := '';
end else if UpperCase (TimeZone) = 'PM' then begin
end else if CompareText(TimeZone, 'PM') = 0 then begin
AMPM := True;
PM := True;
TimeZone := '';
@ -2533,7 +2534,7 @@ begin
{ validate day of week and Month name vs. expected }
// if not ((Pos(UpperCase(Dow), DayString) mod 9) = 1) then Exit; // !!!
if not ((Pos(UpperCase(Mon), MonthString) mod 9) = 1) then Exit;
if not ((PosI(Mon, MonthString) mod 9) = 1) then Exit;
{ correct two digit years }
Year := EpochStr(Year);