zmisc2.htm

对于学习很有帮助

                'Diner Club/Carte Blanche',
                'American Express',
                'Diner Club/Carte Blanche',
                'American Express',
                'Diner Club/Carte Blanche',
                'Visa',
                'MasterCard',
                'MasterCard',
                'MasterCard',
                'MasterCard',
                'MasterCard',
                'Discover' );


function RemoveChar(const Input: String; DeletedChar: Char): String;
var
  Index: Word;                    { counter variable                              }
begin
  { all this function does is iterate through string looking for char, if found   }
  { it deletes it                                                                 }
  Result := Input;
  for Index := Length( Result ) downto 1 do
    if Result[ Index ] = DeletedChar then Delete( Result, Index, 1 );
end;

function ShiftMask( Input: Integer ): Integer;
begin
   { simply a wrapper for this left bit shift operation                           }
   result := ( 1 shl ( Input - 12 ) );
end;

function ConfirmChecksum( CardNumber: String ): Boolean;
var
   CheckSum: Integer;             { Holds the value of the operation              }
   Flag: Boolean;                 { used to indicate when ready                   }
   Counter: Integer;              { index counter                                 }
   PartNumber: String;            { used to extract each digit of number          }
   Number: Integer;               { used to convert each digit to integer         }
begin

   {**************************************************************************
   This is probably the most confusing part of the code you will see, I know
   that it is some of the most confusing I have ever seen.  Basically, this
   function is extracting each digit of the number and subjecting it to the
   checksum formula established by the credit card companies.  It works from
   the end to the front.
   **************************************************************************}

   { get the starting value for our counter }
   Counter := Length( CardNumber  );
   CheckSum := 0;
   PartNumber := '';
   Number := 0;
   Flag := false;

   while ( Counter >= 1 ) do
   begin
      { get the current digit }
      PartNumber :=  Copy( CardNumber, Counter, 1 );
      Number := StrToInt( PartNumber ); { convert to integer }
      if ( Flag ) then { only do every other digit }
      begin
         Number := Number * 2;
         if ( Number >= 10 ) then Number := Number - 9;
      end;
      CheckSum := CheckSum + Number;

      Flag := not( Flag );

      Counter := Counter - 1;
   end;

   result := ( ( CheckSum mod 10 ) = 0 );
end;

function GetMask( CardName: String  ): Integer;
begin
   { the default case }
   result := 0;

   if ( CardName = 'MasterCard' ) then result := ShiftMask( 16 );
   if ( CardName = 'Visa' ) then result := ( ShiftMask( 13 ) or ShiftMask( 16 ) );
   if ( CardName = 'American Express' ) then result := ShiftMask( 15 );
   if ( CardName = 'Diner Club/Carte Blanche' ) then result := ShiftMask( 14 );
   if ( CardName = 'Discover' ) then result := ShiftMask( 16 );

end;

function IsValidCreditCardNumber( CardNumber: String; var MessageText: String ): Boolean;
var
   StrippedNumber: String;        { used to hold the number bereft of extra chars }
   Index: Integer;                { general purpose counter for loops, etc        }
   TheMask: Integer;              { number we will use for the mask               }
   FoundIt: Boolean;              { used to indicate when something is found      }
   CardName: String;              { stores the name of the type of card           }
   PerformChecksum: Boolean;      { the enRoute type of card doesn't get it       }
begin

   { first, get rid of spaces, dashes }
   StrippedNumber := RemoveChar( CardNumber, ' ' );
   StrippedNumber := RemoveChar( StrippedNumber, '-' );

   { if the string was zero length, then OK too }
   if ( StrippedNumber = '' ) then
   begin
      result := true;
      exit;
   end;


   { initialize return variables }
   MessageText := '';
   result := true;

   { set our flag variable }
   FoundIt := false;

   { check for invalid characters right off the bat }
   for Index := 1 to Length( StrippedNumber ) do
   begin
      case StrippedNumber[ Index ] of
         '0'..'9': FoundIt := FoundIt;   { non op in other words }
      else
         MessageText := 'Invalid Characters in Input';
         result := false;
         exit;
      end;
   end;

   { now let's determine what type of card it is }
   for Index := 1 to 19 do
   begin
      if ( Pos( CardPrefixes[ Index ], StrippedNumber ) = 1 ) then
      begin
         { we've found the right one }
         FoundIt := true;
         CardName := CardTypes[ Index ];
         TheMask := GetMask( CardName );
      end;
   end;

   { if we didn't find it, indicates things are already ary }
   if ( not FoundIt ) then
   begin
      CardName := 'Unknown Card Type';
      TheMask := 0;
      MessageText := 'Unknown Card Type ';
      result := false;
      exit;
   end;

   { check the length }
   if ( ( Length( StrippedNumber ) > 28 ) and result ) then
   begin
      MessageText := 'Number is too long ';
      result := false;
      exit;
   end;


   { check the length }
   if ( ( Length( StrippedNumber ) < 12 ) or
    ( ( shiftmask( length( strippednumber ) ) and themask ) = 0 ) ) then
   begin
      messagetext := 'number length incorrect';
      result := false;
      exit;
   end;

   { check the checksum computation }
   if ( cardname = 'enroute' ) then
      performchecksum := false
   else
      performchecksum := true;

   if ( performchecksum and ( not confirmchecksum( strippednumber ) ) ) then
   begin
      messagetext := 'bad checksum';
      result := false;
      exit;
   end;

   { if result is still true, then everything is ok }
   if ( result ) then
      messagetext := 'number ok: card type: ' + cardname;

   { if the string was zero length, then ok too }
   if ( strippednumber = '' ) then
      result := true;

end;

end.</pre><hr>

<P><H1><A NAME="zmisc210">Searching text in a textfile<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>


<PRE>Anyone knows which is the best way (speed) to look for a string in a
textFile.</PRE>


<HR><PRE>
unit BMSearch;


(* -------------------------------------------------------------------
   Boyer-Moore string searching.

   This is one of the fastest string search algorithms.
   See a description in:

     R. Boyer and S. Moore.
     A fast string searching algorithm.
     Communications of the ACM 20, 1977, Pags 762-772
------------------------------------------------------------------- *)


interface

type
{$ifdef WINDOWS}
   size_t = Word;
{$else}
   size_t = LongInt;
{$endif}

type
   TTranslationTable = array[char] of char;  { translation table }

   TSearchBM = class(TObject)
   private
      FTranslate  : TTranslationTable;     { translation table }
      FJumpTable  : array[char] of Byte;   { Jumping table }
      FShift_1    : integer;
      FPattern    : pchar;
      FPatternLen : size_t;

   public
      procedure Prepare( Pattern: pchar; PatternLen: size_t; IgnoreCase: Boolean );
      procedure PrepareStr( const Pattern: string; IgnoreCase: Boolean );

      function  Search( Text: pchar; TextLen: size_t ): pchar;
      function  Pos( const S: string ): integer;
   end;




implementation


uses  SysUtils;



(* -------------------------------------------------------------------
   Ignore Case Table Translation
------------------------------------------------------------------- *)

procedure CreateTranslationTable( var T: TTranslationTable; IgnoreCase: Boolean );
var
   c: char;
begin
   for c := #0 to #255 do
       T[c] := c;

   if not IgnoreCase then
      exit;
      
   for c := 'a' to 'z' do
      T[c] := UpCase(c);

   { Mapping all acented characters to their uppercase equivalent }
   
   T['?] := 'A';
   T['?] := 'A';
   T['?] := 'A';
   T['?] := 'A';

   T['?] := 'A';
   T['?] := 'A';
   T['?] := 'A';
   T['?] := 'A';

   T['?] := 'E';
   T['?] := 'E';
   T['?] := 'E';
   T['?] := 'E';

   T['?] := 'E';
   T['?] := 'E';
   T['?] := 'E';
   T['?] := 'E';

   T['?] := 'I';
   T['?] := 'I';
   T['?] := 'I';
   T['?] := 'I';

   T['?] := 'I';
   T['?] := 'I';
   T['?] := 'I';
   T['?] := 'I';

   T['?] := 'O';
   T['?] := 'O';
   T['?] := 'O';
   T['?] := 'O';

   T['?] := 'O';
   T['?] := 'O';
   T['?] := 'O';
   T['?] := 'O';

   T['?] := 'U';
   T['?] := 'U';
   T['?] := 'U';
   T['?] := 'U';

   T['?] := 'U';
   T['?] := 'U';
   T['?] := 'U';
   T['?] := 'U';

   T['?] := '?;
end;



(* -------------------------------------------------------------------
   Preparation of the jumping table
------------------------------------------------------------------- *)

procedure TSearchBM.Prepare( Pattern: pchar; PatternLen: size_t;
                             IgnoreCase: Boolean );
var
   i: integer;
   c, lastc: char;
begin
   FPattern := Pattern;
   FPatternLen := PatternLen;

   if FPatternLen &lt; 1 then
      FPatternLen := strlen(FPattern);

   { This algorythm is based in a character set of 256 }

   if FPatternLen &gt; 256 then
      exit;


   { 1. Preparing translating table }

   CreateTranslationTable( FTranslate, IgnoreCase);


   { 2. Preparing jumping table }

   for c := #0 to #255 do
      FJumpTable[c] := FPatternLen;

   for i := FPatternLen - 1 downto 0 do begin
      c := FTranslate[FPattern[i]];
      if FJumpTable[c] &gt;= FPatternLen - 1 then
         FJumpTable[c] := FPatternLen - 1 - i;
   end;

   FShift_1 := FPatternLen - 1;
   lastc := FTranslate[Pattern[FPatternLen - 1]];

   for i := FPatternLen - 2 downto 0 do
      if FTranslate[FPattern[i]] = lastc  then begin
         FShift_1 := FPatternLen - 1 - i;
         break;
      end;

   if FShift_1 = 0 then
      FShift_1 := 1;
end;


procedure TSearchBM.PrepareStr( const Pattern: string; IgnoreCase: Boolean );
var
   str: pchar;
begin
   if Pattern &lt;&gt; '' then begin
{$ifdef Windows}
      str := @Pattern[1];
{$else}
      str := pchar(Pattern);
{$endif}

      Prepare( str, Length(Pattern), IgnoreCase);
   end;
end;



{ Searching Last char & scanning right to left }

function TSearchBM.Search( Text: pchar; TextLen: size_t ): pchar;
var
   shift, m1, j: integer;
   jumps: size_t;
begin
   result := nil;
   if FPatternLen &gt; 256 then
      exit;

   if TextLen &lt; 1 then
      TextLen := strlen(Text);


   m1 := FPatternLen - 1;
   shift := 0;
   jumps := 0;

   { Searching the last character }

   while jumps &lt;= TextLen do begin
      Inc( Text, shift);
      shift := FJumpTable[FTranslate[Text^]];
      while shift &lt;&gt; 0 do begin
          Inc( jumps, shift);
          if jumps &gt; TextLen then
             exit;

          Inc( Text, shift);
          shift := FJumpTable[FTranslate[Text^]];
      end;

      { Compare right to left FPatternLen - 1 characters }

      if jumps &gt;= m1 then begin
         j := 0;
         while FTranslate[FPattern[m1 - j]] = FTranslate[(Text - j)^] do begin
            Inc(j);
            if j = FPatternLen then begin
               result := Text - m1;
               exit;
            end;
         end;
      end;

      shift := FShift_1;
      Inc( jumps, shift);
   end;
end;


function TSearchBM.Pos( const S: string ): integer;
var
   str, p: pchar;
begin
   result := 0;
   if S &lt;&gt; '' then begin
{$ifdef Windows}
      str := @S[1];
{$else}
      str := pchar(S);
{$endif}

      p := Search( str, Length(S));
      if p &lt;&gt; nil then
         result := 1 + p - str;
   end;
end;

end.</PRE><HR>

<P><H1><A NAME="zmisc211">Cool tip for hints on status bars<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>

<I>[David Strange, [e-mail]]</I><P>
I just figured out how to have the status bars on multiple forms display
hints correctly with minimal coding.  There have been a couple of solutions
out there, but you had to code for each form (as far as I have seen
anyway).<p>

<B>Step 1:</B><P>
Place a TStatusBar on every form you want hints on.  Set the SimplePanel
property to True, and give them all the same name (I use SBStatus).  See
the comment I put in Step 4 regarding the name.<P>

<B>Step 2:</B><P>
Assign all the hints as you want them.  Don't forget the '|' if you want
long hints.<P>

<B>Step 3:</B><P>
In your startup form put this line in the FormCreate

<HR><PRE>
Application.OnHint := DisplayHint;</PRE><HR>

<B>Step 4:</B><P>
Create this procedure.  Please take note of the comments.

<HR><PRE>
procedure TFrmMain.DisplayHint(Sender: TObject);
var
  Counter, NumComps: integer;
begin
  with Screen.ActiveForm do
  begin
    NumComps := ControlCount - 1;
    for Counter := 0 to NumComps do
{SBStatus is what I call all of my status bars.  Change this as needed.}
      if (TControl(Controls[Counter]).Name = 'SBStatus') then
      begin
        if (Application.Hint = '') then
{ConWorkingName is a constant that use.  You can replace it with anything.}
          TStatusBar(Controls[Counter]).SimpleText := ConWorkingName
        else
          TStatusBar(Controls[Counter]).SimpleText := Application.Hint;
        break;
      end;
  end;
end; {DisplayHint}</PRE><HR>

Don't forget to put 'Procedure DisplayHint(Sender: TObject) in the Public
section.<P>

That's all you have to do.  If you want any other forms to have hints,
simply whack a TStatusBar on them and set the hints.  I hope everyone likes
this. 

<HR SIZE="6" color="#00FF00">
<FONT SIZE="2">
<a href="mailto:[e-mail]">Please email me</a> and tell me if you liked this page.<BR>
<SCRIPT LANGUAGE="JavaScript">
<!--
	document.write("Last modified " + document.lastModified);
// -->
</SCRIPT><P>
<TABLE BORDER=0 ALIGN="CENTER">
<TR>
	<TD>This page has been created with </TD>
	<TD> <A HREF="http://www.dexnet.com./homesite.html">
	     <IMG SRC="../images/hs25ani.gif" WIDTH=88 HEIGHT=31 BORDER=0 ALT="HomeSite 2.5b">
</A></TD>
</TR>
</TABLE>

</FONT>


</BODY>
</HTML>