一个对新人有帮助的问题(300)

周末的时候，被一个网友拖进一个delphi的qq群，群主讨论一个查询（不是用sql）的问题：假设有系列的编号，这些编号是由多部分组成的，中间用“-”连起来例如“A8-2-3”，每部分是由大写字母和数字组成。那么“A8-2-3~A99-99-Z99”就表示一个范围。群主的需要写一个算法，判断一个编号（例如“A8-2-B56”）是否属于上述的范围中。并且要求速度尽量快。我周末花了2个小时写了一个算法尝试了一下，感觉我写的算法速度还凑合，我感觉有不少很多新学delphi的，建议新学delphi的朋友，试试写写 这个算法，我觉得这样对新学delphi有很多的帮助。 另外 我的分很多参与有分 ，速度最快的另外开贴送300，如果觉的分少直接开口要。我自己的代码 回复超过10个时 就发出来unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end;var Form1: TForm1;implementation{$R *.dfm}uses filter;procedure TForm1.Button1Click(Sender: TObject);var Filter_Range: TFilter_Range; s, msg: string; dt: Cardinal; i, c: integer; isInRange: Boolean;begin Filter_Range := TFilter_Range.Create; Filter_Range.Filter := 'A8-2-3' + FilterRangeChar + 'A99-99-Z99';// s := 'A1-1-1'; s := 'A8-2-B56'; c := 10000000;//测试1千万次 dt := GetTickCount; for i := 1 to c do begin isInRange := Filter_Range.check(@s[1], length(s)); end; dt := GetTickCount - dt; if isInRange then msg := '在' else msg := '不在'; msg := Format('%s %s (%s) '#13'运算%d次 耗时%d毫秒', [s, msg, Filter_Range.Filter, c, dt]); showmessage(msg); FreeAndNil(Filter_Range);end;end.

似乎前段时间讨论过了。TFilter_Range是什么啊

顶

看来现在喜欢写代码的 新手越来月少了TFilter_Range 是我自己写的类我目前测试 是千万次 比较 在 一秒以内

看来 没有 多少人 喜欢 讨论 算法这个 是代码我的机器千万次 比较一秒以内配置差点的 可能 要 1.5秒 左右unit filter;interfaceconst FilterSeparator = '-'; FilterRangeChar = '~'; FilterMaxColCount = 255; // hfghfghfg 2009-11-07type PColRec = ^TColRec; TColRec = record P: PChar; Length: Integer; end; TNumRec = record Col: array[0..FilterMaxColCount - 1] of TColRec; Colcount: Integer; end; TFilter_Base = class private FFilter: string; FIsCompiled: boolean; procedure SetFilter(const Value: string); protected procedure clearCompiled; virtual; function CompileFilter(v: string): boolean; virtual; function docheck(v: pchar; len: integer): boolean; virtual; public destructor Destroy; override; property Filter: string read FFilter write SetFilter; property IsCompiled: Boolean read FIsCompiled; function check(v: pchar; len: integer): boolean; end; TFilter_Range = class(TFilter_Base) private min_v: string; max_v: string; min_Num: TNumRec; max_Num: TNumRec; protected procedure clearCompiled; override; function CompileFilter(v: string): boolean; override; function docheck(v: pchar; len: integer): boolean; override; end;procedure Num2NumRec(v: pchar; len: integer; var Num: TNumRec);implementationuses StrUtils, SysUtils, math;procedure Num2NumRec(v: pchar; len: integer; var Num: TNumRec);var p: pchar; i: integer; PCol: PColRec;begin Num.Colcount := 0; if len <= 0 then exit; p := v; PCol := @(Num.Col[0]); PCol.Length := 0; for i := 1 to len do begin if p^ = FilterSeparator then begin inc(PCol); PCol^.Length := 0; end else begin if PCol^.Length = 0 then begin PCol^.P := p; inc(Num.Colcount); end; inc(PCol^.Length); end; inc(p); end;end;function ComparePchar(p_1, p_2: pchar; len: Integer): integer;var p1, p2: pchar; i: integer;begin Result := 0; p1 := p_1; p2 := p_2; for i := 1 to len do begin if p1^ > p2^ then begin Result := 1; // 大于 exit; end else if p1^ < p2^ then begin Result := -1; // 小于 exit; end; inc(p1); inc(p2); end;end;function CompareNumRec(var Num1, Num2: TNumRec): integer;var i, c: integer; PCol1: PColRec; PCol2: PColRec;begin Result := 0; c := min(Num1.Colcount, Num2.Colcount); PCol1 := @(Num1.Col[0]); PCol2 := @(Num2.Col[0]); for i := 1 to c do begin if PCol1^.Length > PCol2.Length then begin Result := 1; // 大于 end else if PCol1^.Length < PCol2.Length then begin Result := -1; // 小于 end else begin Result := ComparePchar(PCol1.P, PCol2.P, PCol1^.Length); if Result <> 0 then exit; end; inc(PCol1); inc(PCol2); end;end;{ filter }function TFilter_Base.check(v: pchar; len: integer): boolean;begin Result := docheck(v, len);end;procedure TFilter_Base.clearCompiled;begin//end;function TFilter_Base.CompileFilter(v: string): boolean;begin Result := false; try except end; Result := true;end;destructor TFilter_Base.Destroy;begin clearCompiled; inherited;end;function TFilter_Base.docheck(v: pchar; len: integer): boolean;begin Result := false;end;procedure TFilter_Base.SetFilter(const Value: string);begin clearCompiled; FIsCompiled := false; FFilter := Value; FIsCompiled := CompileFilter(FFilter);end;{ TFilter_Range }procedure TFilter_Range.clearCompiled;begin//end;function TFilter_Range.CompileFilter(v: string): boolean;var i: integer; function checkstr(v: string): string; begin Result := UpperCase(Trim(v)) end;begin Result := false; i := Pos(FilterRangeChar, v); if i > 1 then begin try min_v := checkstr(copy(v, 1, i - 1)); Num2NumRec(@min_v[1], length(min_v), min_Num); max_v := checkstr(copy(v, i + 1, maxint)); Num2NumRec(@max_v[1], length(max_v), max_Num); except end; end;end;function TFilter_Range.docheck(v: pchar; len: integer): boolean;var Num: TNumRec;begin Num2NumRec(v, len, Num); if CompareNumRec(Num, min_Num) < 0 then begin result := False; exit; end; if CompareNumRec(Num, max_Num) > 0 then begin result := False; exit; end; Result := true;end;end.

将每段前面填充0或空格为最大长度（实际需要的），再直接比较就可。如下面最大长度为3的情况范围A8-2-3~A99-99-Z99以~分隔取得最小最大为 A8-2-3 A99-99-Z99 ，以'-'分隔及字母和数字补齐最大长度为：00A008-000002-000003 00A099-000099-00Z099将要检查的也补齐为：00A008-000002-00B056然后就可以直接字符串比大小了。

收藏了。感觉补齐的思路也不错。

to czcn你可以写个 示例看看 速度如何吗？我估计 补齐 字符串的 写法应该 很慢啊。

A;:-<=->?@如果我给出这个字符串时候会通过你的鉴别系统？我觉得还是针对标示中允许出现的标示符位置建立集合。然后针对不同的位置进行判断。

而且发现你的标示符大小写敏感。。。

A1;-<=->?@通过了你的系统鉴别。。。不知道这算不算漏洞。。。

这个 只是 我和 一个 网友的 聊的 一个 话题我觉的 还可以 至少 可以 对 新学 delphi的新手 有帮助就 发出来了 至于细节 这个 我也不清楚我那个只是一时游戏之做网友的原话是：编号一般有一定的规则由字母、数字、横杠（-，即减号）组成，字母或数字开头，一般有一定的序列关系。字母统一用大写，不考虑小写。常用的模式有A2-1， AJ3-4， 2-12， 2-2-223常用模式后通常还可能会加字母“B”表示补充，例如A2-1B， 2-12B， 2-2-223B也可用序号方式表示补充，如A2-1-1, A2-1-2，2-12-1， 2-2-223-1常见的匹配需求所有第二册，除2-100～2-150外第一册的1～100，200～250因此，需要设计一种高效直观简单的规则来定义编号范围，各个范围可以与、或、反（即减）等方式组合。

to dark_power我怎么 没看到你 对A8-2-3 的处理啊 也没看到你对 ~ 的处理啊 这个代码 不是 检查编码的 有效性啊这是用来比较大小 计算是不是在一个范围的代码A8-2-3~A99-99-Z99这个的 意思 是从 A8-2-3 到 A99-99-Z99 这个范围也可能是 A8-A2-A3 到 A9-B34-D43 这个范围总之是个范围实际上 就是 用 - 分割为 多列 从首列到最后一列 比较大小 你的那个 代码貌似是 判断 编码合法性的 可能是我 没叙述明白这个要求是 是对已经保存的正确编码 的 过滤

我的算法比你的慢3倍多，但我自认为不易出错，易于扩展和维护。代码如下：unit CheckUnit;interfaceuses Classes;const CheckNum= 10; Sprtr= '-';type TAlpha= set of Char; TCheckBase = class private FRlt: Boolean; FInput: string; procedure doCheckThis; virtual; abstract; protected procedure InitialEnv; virtual; abstract; end; TCheckImp1= class(TCheckBase) private FRes: PChar; Flen: Integer; FDest: array[0..CheckNum - 1] of TAlpha; protected procedure doCheckThis; override; public constructor Create; function CheckThis( pstr: PChar; ilen: Integer): Boolean; procedure InitialEnv; override; procedure GetInput(const iinStr: string); procedure Adjust(const inStr: string); end;implementationuses Dialogs,SysUtils,StrUtils;{ TCheckImp1 }procedure TCheckImp1.Adjust(const inStr: string);var m_stmp : array[1..CheckNum] of Char; m_pos, i : Integer;begin m_pos:= 1; for i:= 1 to CheckNum do m_stmp:= '0'; for i := 1 to Length(inStr) do begin if ((inStr= Sprtr )and(i<4))or((inStr= Sprtr )and(i<7)and(i>4)) then begin m_stmp[m_pos-1]:= '0'; m_stmp[m_pos]:= inStr[i-1]; Inc(m_pos); m_stmp[m_pos]:= Sprtr; end else m_stmp[m_pos]:= inStr; Inc(m_pos); end; Dec(m_pos);// ShowMessage(IntToStr(m_pos)); if m_pos< 10 then case 10- m_pos of 1: begin for i := CheckNum downto m_pos do begin m_stmp:= m_stmp[m_pos]; m_stmp[m_pos]:= '0'; Dec(m_pos); end; end; 2: begin m_stmp[CheckNum]:= m_stmp[m_pos]; m_stmp[m_pos]:= '0'; end; end; FInput:= m_stmp;end;function TCheckImp1.CheckThis(pstr: PChar; ilen: Integer): Boolean;begin FRes:= pstr; Flen:= ilen; doCheckThis; Result:= FRlt;end;constructor TCheckImp1.Create;begin InitialEnv;end;procedure TCheckImp1.doCheckThis;var icntr: Integer; m_pchr: PChar;begin// inherited; m_pchr:= FRes; for icntr := 0 to Flen - 1 do begin if m_pchr^ in FDest[icntr] then begin FRlt:= True; Inc(m_pchr); end else begin FRlt:= False; ShowMessage('Current char is: '+m_pchr^+#13+'Error occurs!'); Exit; end; end;// ShowMessage('They are match!');end;procedure TCheckImp1.GetInput(const iinStr: string);begin Adjust(iinStr);// ShowMessage(FInput); CheckThis(PChar(FInput), Length(FInput));end;procedure TCheckImp1.InitialEnv;begin //A8-2-3~A99-99-Z99 FDest[0]:= ['A','a']; FDest[1]:= ['0'..'9']; FDest[2]:= ['0'..'9']; FDest[3]:= ['-']; FDest[4]:= ['0'..'9']; FDest[5]:= ['0'..'9']; FDest[6]:= ['-']; FDest[7]:= ['0'..'9','A'..'Z','a'..'z']; FDest[8]:= ['0'..'9']; FDest[9]:= ['0'..'9']; FRlt:= False;end;end.

“编号一般有一定的规则由字母、数字、横杠（-，即减号）组成，字母或数字开头，一般有一定的序列关系。字母统一用大写，不考虑小写。常用的模式有A2-1， AJ3-4， 2-12， 2-2-223常用模式后通常还可能会加字母“B”表示补充，例如A2-1B， 2-12B， 2-2-223B也可用序号方式表示补充，如A2-1-1, A2-1-2，2-12-1， 2-2-223-1常见的匹配需求所有第二册，除2-100～2-150外第一册的1～100，200～250因此，需要设计一种高效直观简单的规则来定义编号范围，各个范围可以与、或、反（即减）等方式组合。”我觉得你的问题已经介乎于正则表达式的分析与判断了，远远超出了你认为的控制范围，我也不认为新手能或应该参与这种问题。。。

其实你对问题的叙述非常暧昧。如A8-2-3~A99-99-Z99各个位上的可取值，并没有说明。如，第一位必须是A，第二和第三位是0-99，第五和第六位是0-99，第八位必须是Z和或那些值，第九和第十位是0-99。你并没有给出问题的正确叙述，让别人无法帮你，帮你既费时又无效。依我看，提这种问题给你的人本身恐怕也很混乱。像企业的物料或管理编号，是有硬性规定的，指定位的取值是有约束的，且通常编码长度固定。在编程中对这些硬性规定的标示定义变长码通常是不负责的行为。这对管理和使用效率都没有任何好处。

是的 的 我也不是 很懂 这个是一个 我的网友的一个 问题我也不知道 那个网友 需要啥

我一样 告诉 那个网友用 正则表达式 但是 那个 网友说不喜欢 正则表达式

除去程序员本身的限制和对问题的理解，程序的主要时间都是消耗在对条件的评定和筛选上，所作IO越少，条件判定和筛选越少，运行越快。要减少运算时间通常就得从这些地方下手。像你的算法中对计算和条件筛选非常少，主要是做了字串的格式化和对每个字符做了两次比较。所以应该说是非常少的运算和判断，应该是非常快的了。要比你还快。。。我看只有在格式化上做手脚了或者只进行一次比较，应该比较困难。

提出格式化部分，单纯的核心算法，我感觉应该不比你的低了。unit CheckUnit;interfaceuses Classes;const CheckNum= 10; Sprtr= '-';type TAlpha= set of Char; TCheckBase = class private procedure doCheckThis; virtual; abstract; protected FInput: string; FMin: string; FMax: string; procedure InitialEnv; virtual; abstract; public FRlt: Boolean; end; TCheckImp1= class(TCheckBase) private FRes: PChar; Flen: Integer;// FDest: array[0..CheckNum - 1] of TAlpha; procedure SetMin(const sMin: string); procedure SetMax(const sMax: string); protected procedure doCheckThis; override; public constructor Create; function CheckThis: Boolean; procedure InitialEnv; override; procedure GetInput(const iinStr: string); function Adjust(const inStr: string): string; property Min: string read FMin write SetMin; property Max: string read FMax write SetMax; end;implementationuses Dialogs,SysUtils,StrUtils;{ TCheckImp1 }function TCheckImp1.Adjust(const inStr: string): string;var m_stmp : array[1..CheckNum] of Char; m_pos, i, m_sprtpos: Integer;begin m_pos:= 1; for i:= 1 to CheckNum do m_stmp:= '0'; for i := 1 to Length(inStr) do begin if ((inStr= Sprtr )and(i<4))or((inStr= Sprtr )and(i<7)and(i>4)and(i-m_sprtpos< 3)) then begin m_sprtpos:= i; m_stmp[m_pos-1]:= '0'; m_stmp[m_pos]:= inStr[i-1]; Inc(m_pos); m_stmp[m_pos]:= Sprtr; end else m_stmp[m_pos]:= inStr; Inc(m_pos); end; Dec(m_pos);// ShowMessage(IntToStr(m_pos)); if m_pos< 10 then case 10- m_pos of 1: begin for i := CheckNum downto m_pos do begin m_stmp:= m_stmp[m_pos]; m_stmp[m_pos]:= '0'; Dec(m_pos); end; end; 2: begin m_stmp[CheckNum]:= m_stmp[m_pos]; m_stmp[m_pos]:= '0'; end; end; Result:= m_stmp;end;function TCheckImp1.CheckThis: Boolean;begin doCheckThis; Result:= FRlt;end;constructor TCheckImp1.Create;begin InitialEnv;end;procedure TCheckImp1.doCheckThis;var icntr: Integer; m_pchr: PChar;begin// inherited; if (CompareStr(FInput, FMin)< 0 )or (CompareStr(FInput, FMax)> 0) then begin FRlt:= False; end else begin FRlt:= True; end;end;procedure TCheckImp1.GetInput(const iinStr: string);var m_str: string;begin m_str:= InputBox('InputBox','Input Pattern strng','A8-2-3');// m_str:= iinStr; FInput:= Adjust(m_str); ShowMessage(FInput);end;procedure TCheckImp1.InitialEnv;begin //A8-2-3~A99-99-Z99 FRlt:= False;end;procedure TCheckImp1.SetMax(const sMax: string);begin FMax:= Adjust(sMax); ShowMessage(FMax);end;procedure TCheckImp1.SetMin(const sMin: string);begin FMin:= Adjust(sMin); ShowMessage(FMin);end;end.