I have two string lists that I'm working with. One that has a list of keywords, and then another that has a list of negative keywords. I want to be able to search through the list and pick out the list items that do not contain the negative keyword and output to a third keyword list. I was using the AnsiPos function but that found the negative keywords if they were part of a word, vs full word.
Any suggestions on a relatively easy way to do this? Speed is not that important, but would be nice.
Example of what I'm looking to do:
Keyword List:
Cat
Catfish
Fish Sticks
Dog Food
Negative Keyword List:
Fish
Returned Values Wanted:
Cat
Catfish
Dog Food
This is what I've got so far.. which does not work. I used information from: Is There An Efficient Whole Word Search Function in Delphi?
function ExistWordInString(aString: PAnsichar; aSearchString: string;
aSearchOptions: TStringSearchOptions): Boolean;
var
Size : Integer;
begin
Size := StrLen(aString);
result := SearchBuf(aString, Size, 0, 0, aSearchString, aSearchOptions) <> nil;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
i, j, index: integer;
s: string;
stl: tstringlist;
begin
stl := TStringList.Create;
stl.Text := listbox1.Items.Text;
for I := 0 to stl.Count - 1 do
begin
for j := 0 to listbox2.Count - 1 do
begin
if not ExistWordInString(PAnsiChar(listbox2.Items.Strings[j]),
listbox1.Items.Strings[i], [soWholeWord, soDown])
then
listbox3.Items.Append(stl.Strings[i]);
end;
end;
end;
If spaces are the only word delimiter you need to worry about, then you can do a whole word match using AnsiPos by adding a space before and after both the keyword and the negative keyword, ie
AnsiPos(' '+SubStr+' ', ' '+Str+' ')
You'd need a loop to check every entry from the negative keyword list.
this sample code works like a charm (using Delphi 7):
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, StrUtils;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
procedure Button1Click(Sender: TObject);
private
function ExistWordInString(aString, aSearchString:string;aSearchOptions: TStringSearchOptions): Boolean;
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
i,k: integer;
begin
for k:= 0 to ListBox2.Count -1 do
for i:= 0 to ListBox1.Count - 1 do
begin
if not ExistWordInString(ListBox1.Items[i], ListBox2.Items[k],[soWholeWord,soDown]) then
ListBox3.Items.Append(ListBox1.Items[i]);
end;
end;
function TForm1.ExistWordInString(aString, aSearchString: string; aSearchOptions: TStringSearchOptions): Boolean;
var
Size : Integer;
begin
Size:=Length(aString);
Result := SearchBuf(PChar(aString), Size, 0, 0, aSearchString, aSearchOptions)<>nil;
end;
end.
and here's the form:
object Form1: TForm1
Left = 1008
Top = 398
Width = 411
Height = 294
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 320
Top = 8
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object ListBox1: TListBox
Left = 8
Top = 8
Width = 177
Height = 97
ItemHeight = 13
Items.Strings = (
'Cat '
'Catfish'
'Fish Sticks'
'Dog Food')
TabOrder = 1
end
object ListBox2: TListBox
Left = 192
Top = 8
Width = 121
Height = 97
ItemHeight = 13
Items.Strings = (
'Fish')
TabOrder = 2
end
object ListBox3: TListBox
Left = 8
Top = 112
Width = 305
Height = 137
ItemHeight = 13
TabOrder = 3
end
end
hope this helps.
Reinhard :-)
I think I figured it out. Use stringlist.find('fish',index);
I didn't figure it out. .find did not work.
-Brad
You can use the SearchBuf function (see the pastacool's answer) IF you are not interested in other characters except A..Z / Unicode.
If you have an Unicode Delphi (D2009 or D2010) then you must use TCharacter.IsLetterOrDigit(aString: string; aIndex: integer): boolean; from the Character unit. A simple example for you to get the idea:
procedure TForm7.btn1Click(Sender: TObject);
var
bMatches: boolean;
begin
with rgx1 do //custom component - disregard it
begin
RegEx:=edtTextToFind.Text; //text to find
Subject:=mmoResult.Text; //text in which to search
if Match then //aha! found it!
begin
bMatches:=True;
if chkWholeWord.Checked then //be attentive from here!! - I think that's self explaining...
begin
if MatchedExpressionOffset>1 then
bMatches:=not TCharacter.IsLetterOrDigit(Subject, MatchedExpressionOffset-1);
if bMatches and (MatchedExpressionOffset+MatchedExpressionLength<=Length(Subject)) then
bMatches:=not TCharacter.IsLetterOrDigit(Subject, MatchedExpressionOffset+MatchedExpressionLength);
end;
if bMatches then //select it in the memo
begin
mmoResult.SelStart:=MatchedExpressionOffset-1;
mmoResult.SelLength:=MatchedExpressionLength;
mmoResult.SetFocus;
end
else
ShowMessage('Text not found!');
end
else
ShowMessage('Text not found!');
end;
end;
Change your function to read:
function ExistWordInString(aString:PAnsichar;
aSearchString:string;
aSearchOptions: TStringSearchOptions): Boolean;
var
b : boolean;
begin
if soWholeWord in aSearchOptions then
b := Pos(' '+Uppercase(aSearchString)+' ',' '+UpperCase(aString)+' ') > 0;
else
b := Pos(UpperCase(aSearchString),UpperCase(aString)) > 0;
Result := b;
end;
If your using Delphi 2009/2010 then change it from Pos to AnsiPos. My assumption here is that soWholeWord means that the match "Fish" would match "Fish Sticks" but not "catfish".
Related
(Minimal RepEx at the end)
I have a DBGrid (actually a TSMDBgrid) populated by a query.
One field, payment_made, is Boolean and displays in the grid as a checkbox either ticked or unticked. depending upon the field value. This is the only field that can be edited. Initially all rows are unticked
I'm using the often published DrawColumnCell() code below to change the whole row colour to blue if the Boolean field on that row gets changed to checked (true) and back to white if it subsequently gets unchecked (false).
I want all rows that are checked to remain blue.
The code I use is
procedure TFrmBulkSubdPaymentRecord.SMDBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect;
DataCol: Integer;
Column: TColumn;
State: TGridDrawState);
//see https://www.thoughtco.com/change-coloring-in-tdbgrid-component-4077252
begin
if MyQuery1.FieldByName('payment_made').AsBoolean = true then
SMDBGrid1.Canvas.Brush.Color := $00ffff99//pale blue
else
SMDBGrid1.Canvas.Brush.Color := clwhite;
SMDBGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State);
end;
When starting with a white grid, if I check the payment_made box in ,say, row 3 the whole row goes blue.
If I check another row, say row 6 then that whole row row goes blue.
If I then uncheck row 3 the whole of that row goes white again
But, if I then check row 3 again, this time just the payment_made cell goes blue, not the whole row
It looks like could be something to do with the OnDrawColumnCell() not being called for every cell.
Am I doing this the right way or have I missed something?
I've looked at this post and several other related posts but it appears I am doing it right (although obviously not)
No other processing is done when the field is clicked as it's all done afterwards in a loop that deals with each checked row in turn.
Incidentally, I use
if MyQuery1.FieldByName('payment_made').AsBoolean = true then
simply to make the code more readable. I realise that the = true is unnecessary and I can live with the extra few microseconds this might add.
Minimal Reproducible example (written in Delphi 2009 and using TSMDBgrid from SM components (although problem seem to exist with the TDGGrid as well)
The .dfm
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 553
ClientWidth = 640
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 344
Top = 56
Width = 61
Height = 13
Caption = '<--- TDBGrid'
end
object Label2: TLabel
Left = 344
Top = 165
Width = 75
Height = 13
Caption = '<--- TSMDBGrid'
end
object DBGrid1: TDBGrid
Left = 8
Top = 16
Width = 321
Height = 97
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
end
object SMDBGrid1: TSMDBGrid
Left = 8
Top = 137
Width = 321
Height = 104
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit]
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
Flat = False
BandsFont.Charset = DEFAULT_CHARSET
BandsFont.Color = clWindowText
BandsFont.Height = -11
BandsFont.Name = 'Tahoma'
BandsFont.Style = []
Groupings = <>
GridStyle.Style = gsCustom
GridStyle.OddColor = clWindow
GridStyle.EvenColor = clWindow
TitleHeight.PixelCount = 24
FooterColor = clBtnFace
ExOptions = [eoBooleanAsCheckBox, eoENTERlikeTAB, eoKeepSelection, eoStandardPopup, eoBLOBEditor, eoTitleWordWrap, eoFilterAutoApply]
RegistryKey = 'Software\Scalabium'
RegistrySection = 'SMDBGrid'
WidthOfIndicator = 11
DefaultRowHeight = 24
ScrollBars = ssHorizontal
end
object btnSetTrue: TButton
Left = 480
Top = 111
Width = 75
Height = 25
Caption = 'btnSetTrue'
TabOrder = 2
OnClick = btnSetTrueClick
end
object btnSetFalse: TButton
Left = 480
Top = 160
Width = 75
Height = 25
Caption = 'btnSetFalse'
TabOrder = 3
OnClick = btnSetFalseClick
end
object Memo1: TMemo
Left = 8
Top = 304
Width = 609
Height = 241
Lines.Strings = (
'Top grid is TDBGrid, botton grid is TSMDBGrid'
'Both use DataSource1 as their datasource'
'Both have the same code for their OnDBGrid1DrawColumnCell'
'When the field '#39'payment_made'#39' is TRUE the whole row should be bl' +
'ue, when it is false the whole rowq should be white'
''
'Correct operation'
'=========='
''
'Change the value of the boolean field using the buttons. '
'This operates correctly, the whole row in each grid changes to b' +
'lue or whire correctly. '
'problem evident.'
''
'To reproduce the problem'
'==============='
''
'Change the boolean field from true to false or vice versa using ' +
'either the check box in SMDBGrid or by typing true '
'or false in the DBGrid.'
'Sometimes only one cell on the row changes to the correct colour' +
', leaving other cells on the row the wrong colour.')
TabOrder = 4
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
Left = 376
Top = 240
end
object DataSource1: TDataSource
Left = 448
Top = 240
end
end
The .pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, SMDBGrid, Grids, DBGrids, DB, DBClient;
type
TForm1 = class(TForm)
ClientDataSet1: TClientDataSet;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
SMDBGrid1: TSMDBGrid;
btnSetTrue: TButton;
btnSetFalse: TButton;
Memo1: TMemo;
Label1: TLabel;
Label2: TLabel;
procedure FormShow(Sender: TObject);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure SMDBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure btnSetTrueClick(Sender: TObject);
procedure btnSetFalseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnSetFalseClick(Sender: TObject);
begin
ClientDataSet1.FieldByName('payment_made').AsBoolean := false;
SMDBGrid1.Refresh ;
DBGrid1.refresh
end;
procedure TForm1.btnSetTrueClick(Sender: TObject);
begin
ClientDataSet1.FieldByName('payment_made').AsBoolean := true;
SMDBGrid1.Refresh ;
DBGrid1.refresh
end;
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if ClientDataSet1.FieldByName('payment_made').AsBoolean = true then
DBGrid1.Canvas.Brush.Color := $00ffff99//pale blue
else
DBGrid1.Canvas.Brush.Color := clwhite;
DBGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
//define dataset fields
ClientDataSet1.FieldDefs.Add('payment_made', ftBoolean);
ClientDataSet1.FieldDefs.Add('second_column', ftString, 10);
ClientDataSet1.CreateDataSet;
ClientDataSet1.LogChanges := False;
//put in one row of data
ClientDataSet1.Append; // insertfirst row
ClientDataSet1.FieldByName('payment_made').AsBoolean := false;
ClientDataSet1.FieldByName('second_column').AsString := 'row one';
ClientDataSet1.Post;
//leave it in editing mode (although this doesn't seem to make any difference)
ClientDataSet1.Edit;
//set option for SMDBgrid to display booleans as a checkbox
SMDBGrid1.ExOptions := SMDBGrid1.ExOptions + [eoBooleanAsCheckBox] ;
//link components together
DataSource1.DataSet := ClientDataSet1;
SMDBGrid1.DataSource := DataSource1;
DBGrid1.DataSource := DataSource1;
//point the grids to their respective OnDrawColumnCell routines
DBGrid1.OnDrawColumnCell := DBGrid1DrawColumnCell ;
SMDBGrid1.OnDrawColumnCell := SMDBGrid1DrawColumnCell ;
end;
procedure TForm1.SMDBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if ClientDataSet1.FieldByName('payment_made').AsBoolean = true then
SMDBGrid1.Canvas.Brush.Color := $00ffff99//pale blue
else
SMDBGrid1.Canvas.Brush.Color := clwhite;
SMDBGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State);
end;
end.
I want to use a custom Hint window class for my entire application.
I use the Application.OnShowHint, analyze the THintInfo, and return my own TMyHintWindow in the HintInfo.HintWindowClass. This works well for all controls but I have a strange problem only with TVirtualStringTree Columns hint.
VT uses it's own hint window and own structure for the HintInfo.HintData. I study the code, and know it uses the VTHintData. so far so good. problem is that when I return my own hint window class (derived from THintWindow) it shows the hint window only for a split second and disappears!
There is no problem with hints returned for tree Nodes. they use the same method/structure (VTHintData).
Here is a very simple MCVE:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, StdCtrls;
type
TForm1 = class(TForm)
VirtualStringTree1: TVirtualStringTree;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
public
procedure ApplicationShowHint(var HintStr: string; var CanShow: Boolean;
var HintInfo: THintInfo);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TMyHintWindow = class(THintWindow)
public
{ nothing special here for now }
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
VirtualStringTree1.Hint := 'VT main hint';
VirtualStringTree1.ShowHint := True;
Memo1.Hint := 'Memo hint';
Memo1.ShowHint := True;
Application.OnShowHint := ApplicationShowHint;
end;
procedure TForm1.ApplicationShowHint(var HintStr: string; var CanShow: Boolean;
var HintInfo: THintInfo);
var
VTHintData: TVTHintData;
begin
{ VT uses it's own hint window class }
if HintInfo.HintWindowClass = TVirtualTreeHintWindow then
begin
{ VT passes columns and nodes hints information in HintInfo.HintData }
if HintInfo.HintData <> nil then
begin
VTHintData := PVTHintData(HintInfo.HintData)^;
if VTHintData.Node <> nil then { node hint }
begin
{ handle this case with DoGetNodeHint/DoGetNodeToolTip ... it works fine }
end
else
begin { column hint }
HintStr := VTHintData.DefaultHint; { got it! }
end;
end;
end;
Memo1.Lines.Add(HintStr); { prove I got the right hint }
HintInfo.HintColor := clAqua;
{ use my own hint window class
the hint from the VT columns is shown for a split second and hides! }
HintInfo.HintWindowClass := TMyHintWindow;
end;
end.
Form:
object Form1: TForm1
Left = 399
Top = 256
Width = 720
Height = 211
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object VirtualStringTree1: TVirtualStringTree
Left = 8
Top = 8
Width = 409
Height = 153
Header.AutoSizeIndex = 0
Header.Font.Charset = DEFAULT_CHARSET
Header.Font.Color = clWindowText
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Font.Style = []
Header.Options = [hoColumnResize, hoDrag, hoShowHint, hoShowSortGlyphs, hoVisible]
HintAnimation = hatNone
HintMode = hmTooltip
TabOrder = 0
Columns = <
item
Position = 0
Width = 150
WideText = 'column 0'
WideHint = 'VT column 0 hint'
end
item
Position = 1
Width = 150
WideText = 'column 1'
WideHint = 'VT column 1 hint'
end>
end
object Memo1: TMemo
Left = 424
Top = 8
Width = 273
Height = 153
ScrollBars = ssVertical
TabOrder = 1
end
end
I have debugged this for hours. I see nothing special.
Why is this happening? who/what closes the hint window right away?
Thanks.
I'm using VT version 5.3.0
In the TBaseVirtualTree.CMHintShowPause() it is stated:
A little workaround is needed here to make the application class
using the correct hint window class. Once the application gets
ShowHint set to true (which is the case when we want to show hints in
the tree) then an internal hint window will be created which is not
our own class (because we don't set an application wide hint window
class but only one for the tree). Unfortunately, this default hint
window class will prevent hints for the non-client area to show up
(e.g. for the header) by calling CancelHint whenever certain messages
arrive. By setting the hint show pause to 0 if our hint class was not
used recently we make sure that the hint timer (in Forms.pas) is
not used and our class is created immediately.
I'm not really sure how to handle this. I think I'll drop the whole idea of using my won hint class for the header columns.
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 5 years ago.
Improve this question
I need a little help on changing the labels shown on a tchart
I use this code to populate the tchart:
With Series1 do
begin
clear;
Add (v[1], 'abcdef', clRed);
Add (v[2], 'aaaaaaaaaaaaaaaaaaaaaaaa', clBlue);
Add (v[3], 'bbbbbbbbbbbbbb', clGreen);
end;
I get this chart:
image of chart
Please help me on changing the labels above the rectangles from the text shown in the image to some other variables via code; also please tell me what can i do to show long texts on the x axis and how to break it on multiple lines
First, I'll assume that your "v" variable was an array of integer; My example it's named "BarValue". The form has a TChart with a 2D Bar Series added.
When you construct the labels, you'll want to replace the spaces and word-breaks with the "TeeLineSeparator" and then maybe rescan them and insert in a "TeeLineSeparator" into much longer words to force them to line-break. (In my example I just broke the long "aaaaaaaaa..." label into words randomly.)
This example worked in the Delphi 10.2 Tokyo and Delphi 2007.
type
TForm1 = class(TForm)
Chart1: TChart;
Series1: TBarSeries;
procedure FormCreate(Sender: TObject);
procedure Series1GetMarkText(Sender: TChartSeries; ValueIndex: Integer; var MarkText: string);
private
BarMark : array[1..3] of string;
BarValue : array[1..3] of integer;
BarLabel : array[1..3] of string;
BarColor : array[1..3] of TColor;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
begin
Chart1.Legend.Visible := false;
// This maybe needed on earlier versions of TChart (e.g. Delphi 2007-)
// to make room for multi-line labels
//Chart1.Axes.Bottom.LabelSize := 32;
Series1.OnGetMarkText := Series1GetMarkText;
BarValue[1] := 100;
BarValue[2] := 200;
BarValue[3] := 300;
BarLabel[1] := 'abcdefg';
BarLabel[2] := 'aaaa'+TeeLineSeparator+'aaaaaaaaa'+TeeLineSeparator+'aaaaaaaaaaa';
BarLabel[3] := 'bbbbbbbbbbbbbb';
BarColor[1] := clRed;
BarColor[2] := clBlue;
BarColor[3] := clGreen;
BarMark[1] := 'ok1';
BarMark[2] := 'ok2';
BarMark[3] := 'ok3';
Series1.Clear;
for i := 1 to 3 do
Series1.Add (BarValue[i], BarLabel[i], BarColor[i]);
end;
procedure TForm1.Series1GetMarkText(Sender: TChartSeries; ValueIndex: Integer; var MarkText: string);
begin
MarkText := BarMark[ValueIndex+1];
end;
The DFM:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 374
ClientWidth = 702
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Chart1: TChart
Left = 204
Top = 40
Width = 400
Height = 250
Title.Text.Strings = (
'TChart')
View3D = False
TabOrder = 0
DefaultCanvas = 'TGDIPlusCanvas'
ColorPaletteIndex = 13
object Series1: TBarSeries
OnGetMarkText = Series1GetMarkText
XValues.Name = 'X'
XValues.Order = loAscending
YValues.Name = 'Bar'
YValues.Order = loNone
end
end
end
I want to check if an IP address is within a range of a minimum and maximum IP address. How can I do that in Delphi?
For example I want to do something like this:
if CheckIp("127.0.0.15","127.0.0.1","127.0.0.255") then ShowMessage('ok');
127.0.0.1 is start value of range, 127.0.0.255 is end value of range and 127.0.0.15 is IP address that will be checked.
For IPv4 addresses, you can simply convert them to their integer forms and then perform standard ordinal comparisons on them.
IPv6 address are too big to convert to integers (unless you use a third party BigInt library), so you would have to convert them to their binary form and compare them byte-by-byte instead.
I'm going to assume that your addresses are IPv4 addresses stored in a 32 bit integer in host byte order. And I'm also assuming that you want a lexicographic ordering so that:
a.b.c.d < p.q.r.s
is compared by first comparing a and p, and if equal then comparing b and q, and so on.
In which case, the natural unsigned integer ordering (using the < or > operators) will produce the ordering that you desire.
If the addresses are in network byte order, then you need to convert to host byte order before comparing.
In your question, you have addresses as strings. So you'd need to convert them to network byte order 32 bit unsigned integers with inet_addr, and then to host byte order with ntohl. And then you could compare.
I asked a slightly similar question here before, for general string routines for IP addresses. Based off of the answer by NGLN, I have implemented a set of comparison functions, and a demo application. The function IPRange detects whether it's v4 or v6 and compares them accordingly.
uMain.pas
unit uMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
IPTypes;
type
TfrmCheckIPRange = class(TForm)
txtFrom: TEdit;
txtTo: TEdit;
txtIP: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
txtResult: TEdit;
Label4: TLabel;
procedure DoCheck(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmCheckIPRange: TfrmCheckIPRange;
implementation
{$R *.dfm}
function IntRange(const Val, Min, Max: Integer): Boolean;
begin
Result:= (Val >= Min) and (Val <= Max);
end;
function IPRangeV4(const IP, IPFrom, IPTo: TIPv4): Boolean;
begin
Result:= IntRange(IP.D, IPFrom.D, IPTo.D);
if Result then
Result:= IntRange(IP.C, IPFrom.C, IPTo.C);
if Result then
Result:= IntRange(IP.B, IPFrom.B, IPTo.B);
if Result then
Result:= IntRange(IP.A, IPFrom.A, IPTo.A);
end;
function IPRangeV6(const IP, IPFrom, IPTo: TIPv6): Boolean;
begin
Result:= IntRange(IP.H, IPFrom.H, IPTo.H);
if Result then
Result:= IntRange(IP.G, IPFrom.G, IPTo.G);
if Result then
Result:= IntRange(IP.F, IPFrom.F, IPTo.F);
if Result then
Result:= IntRange(IP.E, IPFrom.E, IPTo.E);
if Result then
Result:= IntRange(IP.D, IPFrom.D, IPTo.D);
if Result then
Result:= IntRange(IP.C, IPFrom.C, IPTo.C);
if Result then
Result:= IntRange(IP.B, IPFrom.B, IPTo.B);
if Result then
Result:= IntRange(IP.A, IPFrom.A, IPTo.A);
end;
function IPRange(const IP, IPFrom, IPTo: String): Boolean;
var
IP4, FR4, TO4: TIPv4;
IP6, FR6, TO6: TIPv6;
function IsV4(const S: String): Boolean;
begin
Result:= Pos('.', S) > 1;
end;
function IsV6(const S: String): Boolean;
begin
Result:= Pos(':', S) > 0;
end;
begin
Result:= False;
if (IsV6(IP)) and (IsV6(IPFrom)) and (IsV6(IPTo)) then begin
IP6:= StrToIPv6(IP);
FR6:= StrToIPv6(IPFrom);
TO6:= StrToIPv6(IPTo);
Result:= IPRangeV6(IP6, FR6, TO6);
end else
if (IsV4(IP)) and (IsV4(IPFrom)) and (IsV4(IPTo)) then begin
IP4:= StrToIPv4(IP);
FR4:= StrToIPv4(IPFrom);
TO4:= StrToIPv4(IPTo);
Result:= IPRangeV4(IP4, FR4, TO4);
end else begin
raise Exception.Create('Invalid IP Address Input');
end;
end;
{ TfrmCheckIPRange }
procedure TfrmCheckIPRange.FormCreate(Sender: TObject);
begin
DoCheck(nil);
end;
procedure TfrmCheckIPRange.DoCheck(Sender: TObject);
begin
try
if IPRange(txtIP.Text, txtFrom.Text, txtTo.Text) then begin
txtResult.Text:= 'IP is in range';
txtResult.Color:= clGreen;
end else begin
txtResult.Text:= 'IP is NOT in range';
txtResult.Color:= clRed;
end;
except
on e: exception do begin
txtResult.Text:= e.Message;
txtResult.Color:= clYellow;
end;
end;
end;
end.
uMain.dfm
object frmCheckIPRange: TfrmCheckIPRange
Left = 350
Top = 113
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Check IP Range'
ClientHeight = 124
ClientWidth = 296
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
DesignSize = (
296
124)
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 11
Top = 11
Width = 71
Height = 13
Alignment = taRightJustify
Caption = 'IP To Compare'
end
object Label2: TLabel
Left = 11
Top = 38
Width = 71
Height = 13
Alignment = taRightJustify
Caption = 'IP Range From'
end
object Label3: TLabel
Left = 23
Top = 65
Width = 59
Height = 13
Alignment = taRightJustify
Caption = 'IP Range To'
end
object Label4: TLabel
Left = 52
Top = 92
Width = 30
Height = 13
Alignment = taRightJustify
Caption = 'Result'
end
object txtFrom: TEdit
Left = 88
Top = 35
Width = 196
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
Text = '192.168.3.100'
OnChange = DoCheck
ExplicitWidth = 158
end
object txtTo: TEdit
Left = 88
Top = 62
Width = 196
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 2
Text = '192.168.3.200'
OnChange = DoCheck
ExplicitWidth = 158
end
object txtIP: TEdit
Left = 88
Top = 8
Width = 196
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
Text = '192.168.3.105'
OnChange = DoCheck
ExplicitWidth = 158
end
object txtResult: TEdit
Left = 88
Top = 89
Width = 196
Height = 21
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ReadOnly = True
TabOrder = 3
OnChange = DoCheck
ExplicitWidth = 158
end
end
I've tested IPv4, but have NOT tested IPv6, although it should work. I'm not familiar enough with IPv6 to even know different test scenarios.
You may also want to add some logic to check if an IP is within the same subnet, because you might not want to include different subnets. That's as easy as making sure the first 3 numbers (v4) are exactly the same. You may wish to raise an exception if there are any differences in subnets, but that's all up to how you need to implement this.
EDIT
I fixed the logic in determining v4 vs v6, because an IPv6 address could also possibly have a . in it, I had to switch the order of checking from v4-v6 to v6-v4.
Trying to have some main template to change visibility of groupboxes based on the number in main editbox.
EditDay is the edit box, where only numbers are in it
day:=DayOfTheYear(Now);
EditDay.Text:=day;
so it's basicaly the day of the year.
Anyway, I need a groupbox (with a few memos) for everyday of the year. Since this is a file with records, which another program will read off for everyday different infos, I need that file writer first, so I can even make one. That's what this one is
Since I'm doing a record file, there has to be all boxes firstly filled up before I'll write to a file, so I need to have Groupboxes to be visible one at a time, each one for a day I specify in a main TEdit.
Right now I'm stuck with setting the visibility of the groupboxes; The code below gives me Access violation error.
x is the number specified in TEdit named EditDay. I wanted to make an y every other day but the day in EditDay box so all but x;
x : Integer;
y : Integer;
procedure TWriteForm.DayCheckTimer(Sender: TObject);
begin
x:=StrToInt(EditDay.Text);
y:=Not x;
(FindComponent('GroupBox'+IntToStr(x)) as TGroupBox).Visible := True;
(FindComponent('GroupBox'+IntToStr(y)) as TGroupBox).Visible := False;
Tried to set y:=[1..365] and not x; [1..365] - x; and several others, but none of them worked.
Where am I wrong? .. Any help will be appreciated. :))
[I'm kinda beginner, yes..]
view y:=Not x; in the debugger x=1 will be y=-2, you won't find a Compoentr with this name.
You will have to iterate over your componets
For i := 1 to mCount
and set visibilty by condtition
(FindComponent('GroupBox'+IntToStr(i)) as TGroupBox).Visible := y = i;
Here a small sample project to deal with a lot (365) of records.
unit RecordEdit_ViewU;
interface
uses
SysUtils,
Controls, Forms, Dialogs, StdCtrls, System.Classes;
type
TPerson = record
Firstname : string[50]; // shortstring !!
Lastname : string[50]; // shortstring !!
end;
TRecordEdit_View = class( TForm )
Current_Edit : TEdit;
Data_Firstname_Edit : TEdit;
Data_Lastname_Edit : TEdit;
Data_Prev_Button : TButton;
Data_Next_Button : TButton;
Data_Save_Button : TButton;
procedure FormCreate( Sender : TObject );
procedure Current_EditChange( Sender : TObject );
procedure Data_Prev_ButtonClick( Sender : TObject );
procedure Data_Next_ButtonClick( Sender : TObject );
procedure Data_Save_ButtonClick( Sender : TObject );
private
FData : array [1 .. 365] of TPerson;
FCurrent : Integer;
procedure SetCurrent( const Value : Integer );
procedure InitData;
procedure StoreCurrent;
procedure LoadCurrent;
procedure SaveData;
public
property Current : Integer read FCurrent write SetCurrent;
end;
var
RecordEdit_View : TRecordEdit_View;
implementation
{$R *.dfm}
procedure TRecordEdit_View.Current_EditChange( Sender : TObject );
begin
Current := StrToIntDef( Current_Edit.Text, 0 ); // convert text to integer
end;
procedure TRecordEdit_View.Data_Next_ButtonClick( Sender : TObject );
begin
Current := Current + 1; // next record
end;
procedure TRecordEdit_View.Data_Prev_ButtonClick( Sender : TObject );
begin
Current := Current - 1; // prev record
end;
procedure TRecordEdit_View.Data_Save_ButtonClick( Sender : TObject );
begin
SaveData;
end;
procedure TRecordEdit_View.FormCreate( Sender : TObject );
begin
InitData;
end;
procedure TRecordEdit_View.InitData;
begin
FCurrent := Low( FData ); // first record
LoadCurrent; // load data from record
end;
procedure TRecordEdit_View.LoadCurrent;
begin
// Data from record to controls
Data_Firstname_Edit.Text := FData[Current].Firstname;
Data_Lastname_Edit.Text := FData[Current].Lastname;
// Update the Current-Edit
Current_Edit.Text := IntToStr( Current );
end;
procedure TRecordEdit_View.SaveData;
begin
ShowMessage( 'Needs to be implemented!' );
end;
procedure TRecordEdit_View.SetCurrent( const Value : Integer );
begin
// check, if we have a change and if we can change to the new index
if ( Value <> Current ) and ( Value >= Low( FData ) ) and ( Value <= High( FData ) )
then
begin
StoreCurrent; // store data from controls
FCurrent := Value; // change current index
LoadCurrent; // load data from record
end;
end;
procedure TRecordEdit_View.StoreCurrent;
begin
// Data from controls to record
FData[Current].Firstname := Data_Firstname_Edit.Text;
FData[Current].Lastname := Data_Lastname_Edit.Text;
end;
end.
And the form
object RecordEdit_View: TRecordEdit_View
Left = 0
Top = 0
Caption = 'RecordEdit_View'
ClientHeight = 337
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Current_Edit: TEdit
Left = 107
Top = 16
Width = 75
Height = 21
TabOrder = 0
Text = 'Current_Edit'
OnChange = Current_EditChange
end
object Data_Firstname_Edit: TEdit
Left = 80
Top = 56
Width = 129
Height = 21
MaxLength = 50
TabOrder = 1
Text = 'Data_Firstname_Edit'
end
object Data_Lastname_Edit: TEdit
Left = 80
Top = 83
Width = 129
Height = 21
MaxLength = 50
TabOrder = 2
Text = 'Data_Lastname_Edit'
end
object Data_Prev_Button: TButton
Left = 80
Top = 16
Width = 21
Height = 21
Caption = '<'
TabOrder = 3
OnClick = Data_Prev_ButtonClick
end
object Data_Next_Button: TButton
Left = 188
Top = 16
Width = 21
Height = 21
Caption = '>'
TabOrder = 4
OnClick = Data_Next_ButtonClick
end
object Data_Save_Button: TButton
Left = 80
Top = 118
Width = 129
Height = 25
Caption = 'Save Data'
TabOrder = 5
OnClick = Data_Save_ButtonClick
end
end
You can get the complete Source and Executable here