How to determine if the Active Desktop is enabled

Problem/Question/Abstract:

How to determine if the Active Desktop is enabled

Answer:

function IsActiveDeskTopOn: Boolean;
var
  Hd: HWND;
begin
  Result := False;
  Hd := FindWindow(Pchar('Progman'), nil);
  Hd := FindWindowEx(hd, 0, 'SHELLDLL_DefView', nil);
  Hd := FindWindowEx(hd, 0, 'Internet Explorer_Server', nil);
  if hd = 0 then
    Result := False
  else
    Result := True;
end;

Set minimum/maximum values for a resizable form

Problem/Question/Abstract:

Set minimum/maximum values for a resizable form

Answer:

There is a windows message that requests the minimum and the maximum value for a
resizable window ('form').
The following code makes sure that a window of type TForm1 is not smaller than
100x100 and not larger than 200x200 pixels:

type
  TForm1 = class(TForm)
  protected
    procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
      message WM_GETMINMAXINFO;
  end;

procedure TForm1.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
begin
  with Message.MinMaxInfo^ do
  begin
    ptMinTrackSize := Point(100, 100);
    ptMaxTrackSize := Point(200, 200);
  end;
end;

256bit keys for strong encryption

Problem/Question/Abstract:

Understanding what makes a key vulnerable and the pittfalls brought on by brute key searches.

Answer:

The security of any good cryptosystem relies on the key. No matter how large a key, there will be an imposing decrease in security if  it is poorly used by the software. Keys should be measured according to the bits of entropy contained within them, and simple keys should be disallowed. They should contain many different characters, and  have no discernable patterns. Only when these conditions are met will a key withstand dictionary and brute force attacks.

A key's entropy measures the amount of unpredictable bits. Considering users will usually only use alpha-numeric characters, you should only use the minimum number of bits possible to represent that key. Using 8 bits per character means there are 256 different characters available. An attacker knows the user will only use alpha-numeric characters (62 characters, 6 bits), and will not bother testing for the 194 other characters. A practical technique is to convert each character (1 byte) into a 6bit number, and concatenating then next to each other. You could allow only lower case letters and a few numbers and reduce each character to 5bits (32 characters). It is important to demand the user to use passwords that are larger to achieve the same key size. With this said, an 8 character key should not be considered to be 64bits, but in fact 48bits (6bits x 8 characters). Keys with low entropy pose a security threat no matter how well designed the rest of the system is designed.

Short, one-word keys should not be tolerated within a cryptosystem. Even if you optimize entropy, there simply isn't enough key data in a 5 character key to withstand a brute force attack. A 30bit key (6bits x 5 characters) only allows a possibility of a few billion keys, which only takes a few hours to exhaust on a powerful computer. A key of at least 128bits should be required for sesitive data; this ensures a span of a few years before the need arises for a new and longer key. At 6bits per character this means the key should be 22 or more characters long. This may seem large, but
nothing stops you from using phrases. As an example lets look at the phrase "ThE ElevatoR WaS GoinG UP", it is 25 characters long. The key is 150 bits long, but still easy to remember. All keys should be dealt with in this manner. There is no excuse for allowing a user to use an 8 character key and compromising the entire cryptosystem.

A key provides better resistance against algorithmic searches when it contains many different characters. If the key is 22 characters long, but only contains 4 different characters, then it is severely weak. To keep things simple, at least half the characters in a key should be different (22 character key should have at least 11 different characters). More different characters in a key make it harder to statistically predict the next character. Although such an attack is unlikely, there is no room for error. Preventing all known types of attacks and anticipating breaches before-hand is of
utter-most importance no matter how insignificant a risk may seem. A risk is always a risk. It is important to encourage users to have the most different characters they can remember in each key to make algorithmic searches yield no results.

Attackers love patterns, they make key searches and his life much easier. Users seem to think that keys like: "bingobingo" are more secure than those like: "bingo", but the fact is they are only slightly better. Smart attackers know all the tricks users devise to make their keys harder to guess. Using a word twice should be strongly discouraged. Oftentimes users add numbers at the end of the key, to make it less predictable. Unfortunately 80% of the time the number is 123, and the other 20% is 321. For an attacker to test these additional keys, he must also test with 123 added to each key, as well as 321. This means he has to search 3 times as many keys; this only represents a 1.5 bit increase instead of the 18bits 3 characters should offer. Testing keys for patterns can be a very complex obstacle, and will not be discussed in this paper. After obvious patterns have been disallowed it is wise to pass the key through a one-way hash function such as SHA or HAVAL. These functions take an input of data and create an out which has no solvable relationship to the input; for every possible input there is only one output. The output of these hash functions is seemingly random and will effectively disguise any discrete patterns. Eliminating patterns makes it very difficult for an attacker to search for weak keys.

Notes:

I originaly wrote the article above for my website. The source bellow is part of a library in progress cummulating 3 years of research. It's meant to be an example, but if you want to use it in a program, a little bit of credit would be nice.

These key routines have been optimized and re-written a dozen times, I've tried to comment as best I could. The procedure structures may seem odd because I originaly wrote them in C++. The pseudo random number generator comes from an unknown source, and this implementation of haval is a [severe] modification of David Barton's haval.pas found in the DCPcrypt 1.3 component suite. I used context encapsulation so that the procedures wouldn't have to be instantiated in a multi-threaded environment (server maybe?).

Description:

[MutateKey]
Transforms a key into another by expanding and compressing. No previous keys can be determined by the current key, but all the succeeding keys can be. This is usefull for adding entropy to a key (so that there are no shortcuts to brute searches) or for sessions which may need to use multiple session-keys.

[PasswordToKey]
Converts a string with 64 possible characters: 'a'-'z', 'A'-'Z', '0'-'9', '_' and '.' into a 256bit by leaving out 2 bits from every character (64 chars only need 6bits to represent each, instead of 8bits for 256 chars), and then uses MutateKey to add entropy.

[AnanlyzeKey]
Examines a key's entropy by searching for patterns, counting the bits needed per character, evaluation 0/1 (binary) distribution, and derives a summative rating of the key measured in bit-length. (a complete example of this can be found at http://www.geocities.com/drmungkee/software/codebase.html)

//******************* UNIT BEGINS HERE **************************************
unit keyfunc;
interface

type
  key256 = array[0..7] of longword;

  Prng_CTX = record
    r: array[1..97] of real;
    x1, x2, x3: longword;
  end;
  TPrng_CTX = ^Prng_CTX;

  Haval_CTX = record
    lenhi, lenlo: longword;
    Index: longword;
    hash: array[0..7] of longword;
    hashbuffer: array[0..127] of byte;
  end;
  THaval_CTX = ^Haval_CTX;

  KeyStatistics = record
    KeyLength: longword;
    KeySize: longword;
    CharCount: byte;
    CharBits: byte;
    Patterns: longword;
    Differential: longword;
    BruteLength: longword;
    Rating: longword;
  end;
  TKeyStatistics = ^KeyStatistics;

procedure MutateKey(var key: key256);
function PasswordToKey(pass: string): key256;
function AnalyzePassword(pass: string): KeyStatistics;

implementation

const
  BIT_MASK: array[0..7] of byte = (1, 2, 4, 8, 16, 32, 64, 128);
  HASH_SIZE = 256;
  PrngM1: longword = 259200;
  PrngI1: longword = 7141;
  PrngC1: longword = 54773;
  PrngM2: longword = 134456;
  PrngI2: longword = 8121;
  PrngC2: longword = 28411;
  PrngM3: longword = 243000;
  PrngI3: longword = 4561;
  PrngC3: longword = 51349;

  //***************************************************************************
  //                                  Haval
  //
  //     Derived from David Barton's haval.pas (DCPcrypt 1.3 component suite)
  //
  //***************************************************************************

procedure HavalCompress(ctx: THaval_CTX);

  function rr32(x: longword; c: longint): longword; register; assembler;
  asm
      mov ecx,edx
      ror eax,cl
  end;
  procedure r1(var x7, x6, x5, x4, x3, x2, x1, x0: longword; const w: longword);
  var
    t: longword;
  begin
    t := ((x2) and ((x6) xor (x1)) xor (x5) and (x4) xor (x0) and (x3) xor (x6));
    x7 := rr32(t, 7) + rr32(x7, 11) + w;
  end;
  procedure r2(var x7, x6, x5, x4, x3, x2, x1, x0: longword; const w, c: longword);
  var
    t: longword;
  begin
    t := (x3 and (x4 and (not x0) xor x1 and x2 xor x6 xor x5) xor x1 and (x4 xor x2)
      xor x0 and x2 xor x5);
    x7 := rr32(t, 7) + rr32(x7, 11) + w + c;
  end;
  procedure r3(var x7, x6, x5, x4, x3, x2, x1, x0: longword; const w, c: longword);
  var
    t: longword;
  begin
    t := ((x4) and ((x1) and (x3) xor (x2) xor (x5)) xor (x1) and (x0) xor (x3) and
      (x6)
      xor (x5));
    x7 := rr32(t, 7) + rr32(x7, 11) + w + c;
  end;
  procedure r4(var x7, x6, x5, x4, x3, x2, x1, x0: longword; const w, c: longword);
  var
    t: longword;
  begin
    t := (x3 and (x5 and (not x0) xor x2 and (not x1) xor x4 xor x1 xor x6) xor x2
      and (x4 and x0 xor x5 xor x1) xor x0 and x1 xor x6);
    x7 := rr32(t, 7) + rr32(x7, 11) + w + c;
  end;
  procedure r5(var x7, x6, x5, x4, x3, x2, x1, x0: longword; const w, c: longword);
  var
    t: longword;
  begin
    t := (x1 and (x3 and x4 and x6 xor (not x5)) xor x3 and x0 xor x4 and x5
      xor x6 and x2);
    x7 := rr32(t, 7) + rr32(x7, 11) + w + c;
  end;

var
  t7, t6, t5, t4, t3, t2, t1, t0: longword;
  w: array[0..31] of longword;
begin
  t0 := ctx.hash[0];
  t1 := ctx.hash[1];
  t2 := ctx.hash[2];
  t3 := ctx.hash[3];
  t4 := ctx.hash[4];
  t5 := ctx.hash[5];
  t6 := ctx.hash[6];
  t7 := ctx.hash[7];
  move(ctx.hashbuffer, w, sizeof(w));
  r1(t7, t6, t5, t4, t3, t2, t1, t0, w[0]);
  r1(t6, t5, t4, t3, t2, t1, t0, t7, w[1]);
  r1(t5, t4, t3, t2, t1, t0, t7, t6, w[2]);
  r1(t4, t3, t2, t1, t0, t7, t6, t5, w[3]);
  r1(t3, t2, t1, t0, t7, t6, t5, t4, w[4]);
  r1(t2, t1, t0, t7, t6, t5, t4, t3, w[5]);
  r1(t1, t0, t7, t6, t5, t4, t3, t2, w[6]);
  r1(t0, t7, t6, t5, t4, t3, t2, t1, w[7]);
  r1(t7, t6, t5, t4, t3, t2, t1, t0, w[8]);
  r1(t6, t5, t4, t3, t2, t1, t0, t7, w[9]);
  r1(t5, t4, t3, t2, t1, t0, t7, t6, w[10]);
  r1(t4, t3, t2, t1, t0, t7, t6, t5, w[11]);
  r1(t3, t2, t1, t0, t7, t6, t5, t4, w[12]);
  r1(t2, t1, t0, t7, t6, t5, t4, t3, w[13]);
  r1(t1, t0, t7, t6, t5, t4, t3, t2, w[14]);
  r1(t0, t7, t6, t5, t4, t3, t2, t1, w[15]);
  r1(t7, t6, t5, t4, t3, t2, t1, t0, w[16]);
  r1(t6, t5, t4, t3, t2, t1, t0, t7, w[17]);
  r1(t5, t4, t3, t2, t1, t0, t7, t6, w[18]);
  r1(t4, t3, t2, t1, t0, t7, t6, t5, w[19]);
  r1(t3, t2, t1, t0, t7, t6, t5, t4, w[20]);
  r1(t2, t1, t0, t7, t6, t5, t4, t3, w[21]);
  r1(t1, t0, t7, t6, t5, t4, t3, t2, w[22]);
  r1(t0, t7, t6, t5, t4, t3, t2, t1, w[23]);
  r1(t7, t6, t5, t4, t3, t2, t1, t0, w[24]);
  r1(t6, t5, t4, t3, t2, t1, t0, t7, w[25]);
  r1(t5, t4, t3, t2, t1, t0, t7, t6, w[26]);
  r1(t4, t3, t2, t1, t0, t7, t6, t5, w[27]);
  r1(t3, t2, t1, t0, t7, t6, t5, t4, w[28]);
  r1(t2, t1, t0, t7, t6, t5, t4, t3, w[29]);
  r1(t1, t0, t7, t6, t5, t4, t3, t2, w[30]);
  r1(t0, t7, t6, t5, t4, t3, t2, t1, w[31]);
  r2(t7, t6, t5, t4, t3, t2, t1, t0, w[5], $452821E6);
  r2(t6, t5, t4, t3, t2, t1, t0, t7, w[14], $38D01377);
  r2(t5, t4, t3, t2, t1, t0, t7, t6, w[26], $BE5466CF);
  r2(t4, t3, t2, t1, t0, t7, t6, t5, w[18], $34E90C6C);
  r2(t3, t2, t1, t0, t7, t6, t5, t4, w[11], $C0AC29B7);
  r2(t2, t1, t0, t7, t6, t5, t4, t3, w[28], $C97C50DD);
  r2(t1, t0, t7, t6, t5, t4, t3, t2, w[7], $3F84D5B5);
  r2(t0, t7, t6, t5, t4, t3, t2, t1, w[16], $B5470917);
  r2(t7, t6, t5, t4, t3, t2, t1, t0, w[0], $9216D5D9);
  r2(t6, t5, t4, t3, t2, t1, t0, t7, w[23], $8979FB1B);
  r2(t5, t4, t3, t2, t1, t0, t7, t6, w[20], $D1310BA6);
  r2(t4, t3, t2, t1, t0, t7, t6, t5, w[22], $98DFB5AC);
  r2(t3, t2, t1, t0, t7, t6, t5, t4, w[1], $2FFD72DB);
  r2(t2, t1, t0, t7, t6, t5, t4, t3, w[10], $D01ADFB7);
  r2(t1, t0, t7, t6, t5, t4, t3, t2, w[4], $B8E1AFED);
  r2(t0, t7, t6, t5, t4, t3, t2, t1, w[8], $6A267E96);
  r2(t7, t6, t5, t4, t3, t2, t1, t0, w[30], $BA7C9045);
  r2(t6, t5, t4, t3, t2, t1, t0, t7, w[3], $F12C7F99);
  r2(t5, t4, t3, t2, t1, t0, t7, t6, w[21], $24A19947);
  r2(t4, t3, t2, t1, t0, t7, t6, t5, w[9], $B3916CF7);
  r2(t3, t2, t1, t0, t7, t6, t5, t4, w[17], $0801F2E2);
  r2(t2, t1, t0, t7, t6, t5, t4, t3, w[24], $858EFC16);
  r2(t1, t0, t7, t6, t5, t4, t3, t2, w[29], $636920D8);
  r2(t0, t7, t6, t5, t4, t3, t2, t1, w[6], $71574E69);
  r2(t7, t6, t5, t4, t3, t2, t1, t0, w[19], $A458FEA3);
  r2(t6, t5, t4, t3, t2, t1, t0, t7, w[12], $F4933D7E);
  r2(t5, t4, t3, t2, t1, t0, t7, t6, w[15], $0D95748F);
  r2(t4, t3, t2, t1, t0, t7, t6, t5, w[13], $728EB658);
  r2(t3, t2, t1, t0, t7, t6, t5, t4, w[2], $718BCD58);
  r2(t2, t1, t0, t7, t6, t5, t4, t3, w[25], $82154AEE);
  r2(t1, t0, t7, t6, t5, t4, t3, t2, w[31], $7B54A41D);
  r2(t0, t7, t6, t5, t4, t3, t2, t1, w[27], $C25A59B5);
  r3(t7, t6, t5, t4, t3, t2, t1, t0, w[19], $9C30D539);
  r3(t6, t5, t4, t3, t2, t1, t0, t7, w[9], $2AF26013);
  r3(t5, t4, t3, t2, t1, t0, t7, t6, w[4], $C5D1B023);
  r3(t4, t3, t2, t1, t0, t7, t6, t5, w[20], $286085F0);
  r3(t3, t2, t1, t0, t7, t6, t5, t4, w[28], $CA417918);
  r3(t2, t1, t0, t7, t6, t5, t4, t3, w[17], $B8DB38EF);
  r3(t1, t0, t7, t6, t5, t4, t3, t2, w[8], $8E79DCB0);
  r3(t0, t7, t6, t5, t4, t3, t2, t1, w[22], $603A180E);
  r3(t7, t6, t5, t4, t3, t2, t1, t0, w[29], $6C9E0E8B);
  r3(t6, t5, t4, t3, t2, t1, t0, t7, w[14], $B01E8A3E);
  r3(t5, t4, t3, t2, t1, t0, t7, t6, w[25], $D71577C1);
  r3(t4, t3, t2, t1, t0, t7, t6, t5, w[12], $BD314B27);
  r3(t3, t2, t1, t0, t7, t6, t5, t4, w[24], $78AF2FDA);
  r3(t2, t1, t0, t7, t6, t5, t4, t3, w[30], $55605C60);
  r3(t1, t0, t7, t6, t5, t4, t3, t2, w[16], $E65525F3);
  r3(t0, t7, t6, t5, t4, t3, t2, t1, w[26], $AA55AB94);
  r3(t7, t6, t5, t4, t3, t2, t1, t0, w[31], $57489862);
  r3(t6, t5, t4, t3, t2, t1, t0, t7, w[15], $63E81440);
  r3(t5, t4, t3, t2, t1, t0, t7, t6, w[7], $55CA396A);
  r3(t4, t3, t2, t1, t0, t7, t6, t5, w[3], $2AAB10B6);
  r3(t3, t2, t1, t0, t7, t6, t5, t4, w[1], $B4CC5C34);
  r3(t2, t1, t0, t7, t6, t5, t4, t3, w[0], $1141E8CE);
  r3(t1, t0, t7, t6, t5, t4, t3, t2, w[18], $A15486AF);
  r3(t0, t7, t6, t5, t4, t3, t2, t1, w[27], $7C72E993);
  r3(t7, t6, t5, t4, t3, t2, t1, t0, w[13], $B3EE1411);
  r3(t6, t5, t4, t3, t2, t1, t0, t7, w[6], $636FBC2A);
  r3(t5, t4, t3, t2, t1, t0, t7, t6, w[21], $2BA9C55D);
  r3(t4, t3, t2, t1, t0, t7, t6, t5, w[10], $741831F6);
  r3(t3, t2, t1, t0, t7, t6, t5, t4, w[23], $CE5C3E16);
  r3(t2, t1, t0, t7, t6, t5, t4, t3, w[11], $9B87931E);
  r3(t1, t0, t7, t6, t5, t4, t3, t2, w[5], $AFD6BA33);
  r3(t0, t7, t6, t5, t4, t3, t2, t1, w[2], $6C24CF5C);
  r4(t7, t6, t5, t4, t3, t2, t1, t0, w[24], $7A325381);
  r4(t6, t5, t4, t3, t2, t1, t0, t7, w[4], $28958677);
  r4(t5, t4, t3, t2, t1, t0, t7, t6, w[0], $3B8F4898);
  r4(t4, t3, t2, t1, t0, t7, t6, t5, w[14], $6B4BB9AF);
  r4(t3, t2, t1, t0, t7, t6, t5, t4, w[2], $C4BFE81B);
  r4(t2, t1, t0, t7, t6, t5, t4, t3, w[7], $66282193);
  r4(t1, t0, t7, t6, t5, t4, t3, t2, w[28], $61D809CC);
  r4(t0, t7, t6, t5, t4, t3, t2, t1, w[23], $FB21A991);
  r4(t7, t6, t5, t4, t3, t2, t1, t0, w[26], $487CAC60);
  r4(t6, t5, t4, t3, t2, t1, t0, t7, w[6], $5DEC8032);
  r4(t5, t4, t3, t2, t1, t0, t7, t6, w[30], $EF845D5D);
  r4(t4, t3, t2, t1, t0, t7, t6, t5, w[20], $E98575B1);
  r4(t3, t2, t1, t0, t7, t6, t5, t4, w[18], $DC262302);
  r4(t2, t1, t0, t7, t6, t5, t4, t3, w[25], $EB651B88);
  r4(t1, t0, t7, t6, t5, t4, t3, t2, w[19], $23893E81);
  r4(t0, t7, t6, t5, t4, t3, t2, t1, w[3], $D396ACC5);
  r4(t7, t6, t5, t4, t3, t2, t1, t0, w[22], $0F6D6FF3);
  r4(t6, t5, t4, t3, t2, t1, t0, t7, w[11], $83F44239);
  r4(t5, t4, t3, t2, t1, t0, t7, t6, w[31], $2E0B4482);
  r4(t4, t3, t2, t1, t0, t7, t6, t5, w[21], $A4842004);
  r4(t3, t2, t1, t0, t7, t6, t5, t4, w[8], $69C8F04A);
  r4(t2, t1, t0, t7, t6, t5, t4, t3, w[27], $9E1F9B5E);
  r4(t1, t0, t7, t6, t5, t4, t3, t2, w[12], $21C66842);
  r4(t0, t7, t6, t5, t4, t3, t2, t1, w[9], $F6E96C9A);
  r4(t7, t6, t5, t4, t3, t2, t1, t0, w[1], $670C9C61);
  r4(t6, t5, t4, t3, t2, t1, t0, t7, w[29], $ABD388F0);
  r4(t5, t4, t3, t2, t1, t0, t7, t6, w[5], $6A51A0D2);
  r4(t4, t3, t2, t1, t0, t7, t6, t5, w[15], $D8542F68);
  r4(t3, t2, t1, t0, t7, t6, t5, t4, w[17], $960FA728);
  r4(t2, t1, t0, t7, t6, t5, t4, t3, w[10], $AB5133A3);
  r4(t1, t0, t7, t6, t5, t4, t3, t2, w[16], $6EEF0B6C);
  r4(t0, t7, t6, t5, t4, t3, t2, t1, w[13], $137A3BE4);
  r5(t7, t6, t5, t4, t3, t2, t1, t0, w[27], $BA3BF050);
  r5(t6, t5, t4, t3, t2, t1, t0, t7, w[3], $7EFB2A98);
  r5(t5, t4, t3, t2, t1, t0, t7, t6, w[21], $A1F1651D);
  r5(t4, t3, t2, t1, t0, t7, t6, t5, w[26], $39AF0176);
  r5(t3, t2, t1, t0, t7, t6, t5, t4, w[17], $66CA593E);
  r5(t2, t1, t0, t7, t6, t5, t4, t3, w[11], $82430E88);
  r5(t1, t0, t7, t6, t5, t4, t3, t2, w[20], $8CEE8619);
  r5(t0, t7, t6, t5, t4, t3, t2, t1, w[29], $456F9FB4);
  r5(t7, t6, t5, t4, t3, t2, t1, t0, w[19], $7D84A5C3);
  r5(t6, t5, t4, t3, t2, t1, t0, t7, w[0], $3B8B5EBE);
  r5(t5, t4, t3, t2, t1, t0, t7, t6, w[12], $E06F75D8);
  r5(t4, t3, t2, t1, t0, t7, t6, t5, w[7], $85C12073);
  r5(t3, t2, t1, t0, t7, t6, t5, t4, w[13], $401A449F);
  r5(t2, t1, t0, t7, t6, t5, t4, t3, w[8], $56C16AA6);
  r5(t1, t0, t7, t6, t5, t4, t3, t2, w[31], $4ED3AA62);
  r5(t0, t7, t6, t5, t4, t3, t2, t1, w[10], $363F7706);
  r5(t7, t6, t5, t4, t3, t2, t1, t0, w[5], $1BFEDF72);
  r5(t6, t5, t4, t3, t2, t1, t0, t7, w[9], $429B023D);
  r5(t5, t4, t3, t2, t1, t0, t7, t6, w[14], $37D0D724);
  r5(t4, t3, t2, t1, t0, t7, t6, t5, w[30], $D00A1248);
  r5(t3, t2, t1, t0, t7, t6, t5, t4, w[18], $DB0FEAD3);
  r5(t2, t1, t0, t7, t6, t5, t4, t3, w[6], $49F1C09B);
  r5(t1, t0, t7, t6, t5, t4, t3, t2, w[28], $075372C9);
  r5(t0, t7, t6, t5, t4, t3, t2, t1, w[24], $80991B7B);
  r5(t7, t6, t5, t4, t3, t2, t1, t0, w[2], $25D479D8);
  r5(t6, t5, t4, t3, t2, t1, t0, t7, w[23], $F6E8DEF7);
  r5(t5, t4, t3, t2, t1, t0, t7, t6, w[16], $E3FE501A);
  r5(t4, t3, t2, t1, t0, t7, t6, t5, w[22], $B6794C3B);
  r5(t3, t2, t1, t0, t7, t6, t5, t4, w[4], $976CE0BD);
  r5(t2, t1, t0, t7, t6, t5, t4, t3, w[1], $04C006BA);
  r5(t1, t0, t7, t6, t5, t4, t3, t2, w[25], $C1A94FB6);
  r5(t0, t7, t6, t5, t4, t3, t2, t1, w[15], $409F60C4);
  inc(ctx.hash[0], t0);
  inc(ctx.hash[1], t1);
  inc(ctx.hash[2], t2);
  inc(ctx.hash[3], t3);
  inc(ctx.hash[4], t4);
  inc(ctx.hash[5], t5);
  inc(ctx.hash[6], t6);
  inc(ctx.hash[7], t7);
  fillchar(w, sizeof(w), 0);
  ctx.index := 0;
  fillchar(ctx.hashbuffer, sizeof(ctx.hashbuffer), 0);
end;

procedure HavalUpdateLen(ctx: THaval_CTX; len: longword);
begin
  inc(ctx.lenlo, (len shl 3));
  if ctx.lenlo < (len shl 3) then
    inc(ctx.lenhi);
  inc(ctx.lenhi, len shr 29);
end;

procedure HavalFlush(ctx: THaval_CTX);
begin
  ctx.lenhi := 0;
  ctx.lenlo := 0;
  ctx.index := 0;
  fillchar(ctx.hashbuffer, sizeof(ctx.hashbuffer), 0);
  fillchar(ctx.hash, sizeof(ctx.hash), 0);
end;

procedure HavalInit(ctx: THaval_CTX);
begin
  HavalFlush(ctx);
  ctx.hash[0] := $243F6A88;
  ctx.hash[1] := $85A308D3;
  ctx.hash[2] := $13198A2E;
  ctx.hash[3] := $03707344;
  ctx.hash[4] := $A4093822;
  ctx.hash[5] := $299F31D0;
  ctx.hash[6] := $082EFA98;
  ctx.hash[7] := $EC4E6C89;
end;

procedure HavalUpdate(ctx: THaval_CTX; const Buffer; Size: longint);
var
  p: ^byte;
begin
  HavalUpdateLen(ctx, size);
  p := @buffer;
  while size > 0 do
  begin
    if (sizeof(ctx.hashbuffer) - ctx.index) <= longword(size) then
    begin
      move(p^, ctx.hashbuffer[ctx.index], sizeof(ctx.hashbuffer) - ctx.index);
      dec(size, sizeof(ctx.hashbuffer) - ctx.index);
      inc(p, sizeof(ctx.hashbuffer) - ctx.index);
      HavalCompress(ctx);
    end
    else
    begin
      move(p^, ctx.hashbuffer[ctx.index], size);
      inc(ctx.index, size);
      size := 0;
    end;
  end;
end;

procedure HavalFinal(ctx: THaval_CTX; var digest);
begin
  ctx.hashbuffer[ctx.index] := $80;
  if ctx.index > 118 then
    HavalCompress(ctx);
  ctx.hashbuffer[118] := ((HASH_SIZE and 3) shl 6) or (5 shl 3) or 1;
  ctx.hashbuffer[119] := (HASH_SIZE shr 2) and $FF;
  move(ctx.lenlo, ctx.hashbuffer[120], sizeof(ctx.lenlo));
  move(ctx.lenhi, ctx.hashbuffer[124], sizeof(ctx.lenhi));
  HavalCompress(ctx);
  move(ctx.hash, digest, HASH_SIZE div 8);
  HavalFlush(ctx);
end;

//****************************************************************************
//                         PRNG
//****************************************************************************

procedure PrngInit(ctx: TPrng_CTX; seed: longword);
var
  i: byte;
begin
  ctx.x1 := (seed + PrngC1) mod PrngM1;
  ctx.x1 := (ctx.x1 * PrngI1 + PrngC1) mod PrngM1;
  ctx.x2 := ctx.x1 mod PrngM2;
  ctx.x1 := (ctx.x1 * PrngI1 + PrngC1) mod PrngM1;
  ctx.x3 := ctx.x1 mod PrngM3;
  for i := 1 to 97 do
  begin
    ctx.x1 := (ctx.x1 * PrngI1 + PrngC1) mod PrngM1;
    ctx.x2 := (ctx.x2 * PrngI2 + PrngC2) mod PrngM2;
    ctx.r[i] := (ctx.x1 + ctx.x2 / PrngM2) / PrngM1;
  end;
end;

function Prng(ctx: TPrng_CTX): longword;
var
  i: longword;
begin
  ctx.x1 := (ctx.x1 * PrngI1 + PrngC1) mod PrngM1;
  ctx.x2 := (ctx.x2 * PrngI2 + PrngC2) mod PrngM2;
  ctx.x3 := (ctx.x3 * PrngI3 + PrngC3) mod PrngM3;
  i := 1 + (97 * ctx.x3) div PrngM3;
  Prng := trunc($FFFFFFFF * ctx.r[i]);
  ctx.r[i] := (ctx.x1 + ctx.x2 / PrngM2) / PrngM1;
end;

procedure PrngFlush(ctx: TPrng_CTX);
var
  i: byte;
begin
  ctx.x1 := 0;
  ctx.x2 := 0;
  ctx.x3 := 0;
  for i := 1 to 97 do
    ctx.r[i] := 0;
end;

//****************************************************************************
//                         Key Routines
//****************************************************************************

procedure MutateKey(var key: key256);
var
  i: byte;
  exp_key: array[0..1, 0..7] of longword;
  ran_ctx: Prng_CTX;
  hash_ctx: Haval_CTX;
  temp_key: key256;
begin

  //   ***   [1]feed key as 8 seeds into PRNG to generate 16 longs
  for i := 0 to 7 do
  begin
    PrngInit(@ran_ctx, key[i]); //use key as seed data
    exp_key[0, i] := Prng(@ran_ctx); //expand key
    exp_key[1, i] := not Prng(@ran_ctx); //negate to reduce PRNG relationship
  end;

  //   ***   [2]feed [1] as 64 bytes into Haval
  for i := 0 to 7 do
    temp_key[i] := key[i];

  HavalInit(@hash_ctx);
  HavalUpdate(@hash_ctx, exp_key[0][0], 64); //feed expanded key as data
  HavalFinal(@hash_ctx, key);

  //   ***   [3]xor(^) [2] and [1] to produce the final key
  for i := 0 to 7 do
    key[i] := key[i] xor temp_key[i]; //reduce HASH relationship
end;

function PasswordToKey(pass: string): key256;
var
  i, j: integer;
  temp_chars: array[0..42] of byte;
  key_size: byte;
  temp_key: array[0..31] of byte;
  temp_pos: byte;
  bit_pos: byte;
begin

  //   ***   [1]convert 8bit Chars to 6bit bytes
  for i := 1 to length(pass) do
    case byte(pass[i]) of
      97..122: temp_chars[i] := byte(pass[i]) - 97; //if a..z assign 0-25
      65..90: temp_chars[i] := byte(pass[i]) - 39; //if A..Z assign 26-51
      48..57: temp_chars[i] := byte(pass[i]) + 4; //if 0..9 assign 52-61
      byte('.'): temp_chars[i] := 62; //if . assign 62
      byte('_'): temp_chars[i] := 63; //if _ assign 63
    end;

  key_size := (length(pass) * 6) div 8; //keysize with 6bit chars

  //   ***   [2]append 6bit Chars to each other
  temp_pos := 0; //temp buffer position
  bit_pos := 0; //bit position

  for i := 0 to key_size - 1 do //concatonate 6bit chars together
  begin
    temp_key[i] := 0;
    for j := 0 to 7 do
    begin
      inc(temp_key[i],
        ((temp_chars[temp_pos] and BIT_MASK[bit_pos]) shr bit_pos) shl j);
      inc(bit_pos, 1);
      if bit_pos = 6 then
      begin
        bit_pos := 0;
        inc(temp_pos, 1);
      end;
    end;
  end;

  //   ***   [3]make full 256bit key
  //[EDITED 04/25/01] Sorry about the bug. This was originaly done to the
  //passphrase, but I moved it to the process the key instead and forgot to
  //adjust the length from 43 to 32 bytes.  Just change the lines of step [3].
  //Again, sorry.

  if key_size < 32 then
  begin
    j := 0;
    for i := key_size - 1 to 31 do //fill in empty bytes
    begin
      temp_key[i] := temp_key[j] xor i;
      inc(j, 1);
    end;
  end;

  //   ***   [4]eliminate english language redundancy
  MutateKey(key256(temp_key));
  PasswordToKey := key256(temp_key);
end;

function AnalyzePassword(pass: string): KeyStatistics;
var
  i, j: longword;
  key: array[0..1023] of byte;
  chars: array[0..255] of byte;
  pat_pos, pat_len: longword;
  ones, zeros: longword;
  stat: KeyStatistics;
begin

  //   ***   [1]count keylenght
  stat.KeyLength := length(pass);

  //   ***   [2]copy key to buffer
  for i := 0 to stat.KeyLength - 1 do
    key[i] := byte(pass[i]);

  //   ***   [3]count char repetition
  for i := 0 to 255 do
    chars[i] := 0;
  for i := 0 to stat.KeyLength - 1 do
    inc(chars[key[i]], 1);

  //   ***   [4]count different characters
  stat.CharCount := 0;
  for i := 0 to 255 do
    if chars[i] <> 0 then
      inc(stat.CharCount, 1);

  //   ***   [5]count charbits
  stat.CharBits := 0;
  for i := 0 to 7 do
    if stat.CharCount > BIT_MASK[i] then
      inc(stat.CharBits, 1);

  //   ***   [6]count patterns
  pat_pos := 0;
  pat_len := 0;
  repeat
    i := pat_pos;
    repeat
      if (key[i] = key[pat_pos]) and (i <> pat_pos) then //if match is found
        repeat
          inc(pat_len, 1); //increment pattern size
          inc(i, 1); //move to next char
          inc(pat_pos, 1); //next char in pattern
        until (key[i] <> key[pat_pos]) or (i = stat.KeyLength); //until pattern ends
      inc(i, 1);
    until (i > stat.KeyLength - 1); //until finished searching for this pattern
    inc(pat_pos, 1); //start new pattern with the next char
  until pat_pos > stat.KeyLength; //until all patterns have been searched

  if pat_len = 0 then
    stat.Patterns := 0
  else
    stat.Patterns := (pat_len * 100) div stat.KeyLength;

  //   ***   [7]count bit-differential
  ones := 0;
  zeros := 0;
  for i := 0 to stat.KeyLength - 1 do
    for j := 0 to 7 do
      if (key[i] and BIT_MASK[j]) = 0 then
        inc(zeros, 1)
      else
        inc(ones, 1);

  stat.Differential := (longword(abs(ones - zeros)) * 100) div (stat.KeyLength * 8);

  //   ***   [8]count brutelength
  stat.BruteLength := stat.CharBits * stat.KeyLength;

  //   ***   [9]count keysize
  stat.KeySize := stat.KeyLength * 8;

  //   ***   [10]count rating  :=  BL - ((((pat+dif) /2) /100) *BL)
  stat.Rating := stat.BruteLength -
    ((((stat.Patterns + stat.Differential) div 2) * stat.BruteLength) div 100);

  AnalyzePassword := stat;
end;
end.

Check if a point is on a Bezier curve

Problem/Question/Abstract:

How to check if a point is on a Bezier curve

Answer:

Try this simple approach:

{ ... }
p: array[0..3] of TPoint;
{ ... }

procedure TForm1.Button1Click(Sender: TObject);
begin
  p[0] := Point(10, 100);
  {p[1] := Point(1000, 400);}
  {p[2] := Point(- 400, 400);}
  p[1] := Point(200, -100);
  p[2] := Point(400, 400);
  p[3] := Point(600, 100);
  Canvas.Pen.Width := 5;
  Canvas.Pen.Color := clRed;
  Canvas.PolyBezier(p);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  t, t0, t1, t2, t3, tt: double;
  xx, yy: integer;
  p1, p2: array[0..3] of TPoint;
begin
  t := 0;
  repeat
    tt := 1 - t;
    t0 := tt * tt * tt;
    t1 := 3 * tt * tt * t;
    t2 := 3 * tt * t * t;
    t3 := t * t * t;
    xx := Round(p[0].x * t0 + p[1].x * t1 + p[2].x * t2 + p[3].x * t3);
    yy := Round(p[0].y * t0 + p[1].y * t1 + p[2].y * t2 + p[3].y * t3);
    if (abs(xx - x) + abs(yy - y) <= 2) then {rough checking for easy clicking}
      break;
    t := t + 1 / 512;
  until t > 1;
  if t <= 1 then
  begin
    Canvas.Pen.Width := 5;
    Canvas.Pen.Color := clRed;
    Canvas.PolyBezier(p);
    Canvas.Pen.Width := 2;
    Caption := FormatFloat('0.000', t);
    p1[0].x := p[0].x;
    p1[0].y := p[0].y;
    p1[3].x := xx;
    p1[3].y := yy;
    p1[1].x := Round((p[0].x * tt + p[1].x * t));
    p1[1].y := Round((p[0].y * tt + p[1].y * t));
    xx := Round((p[1].x * tt + p[2].x * t));
    yy := Round((p[1].y * tt + p[2].y * t));
    p1[2].x := Round(p1[1].x * tt + xx * t);
    p1[2].y := Round(p1[1].y * tt + yy * t);
    Canvas.Pen.Color := clYellow;
    Canvas.PolyBezier(p1);
    p2[0].x := p1[3].x;
    p2[0].y := p1[3].y;
    p2[3].x := p[3].x;
    p2[3].y := p[3].y;
    p2[2].x := Round((p[2].x * tt + p[3].x * t));
    p2[2].y := Round((p[2].y * tt + p[3].y * t));
    p2[1].x := Round(p2[2].x * t + xx * tt);
    p2[1].y := Round(p2[2].y * t + yy * tt);
    Canvas.Pen.Color := clAqua;
    Canvas.PolyBezier(p2);
  end;
end;

Make a form snap to the border of the screen

Problem/Question/Abstract:

I want my form to snap to the left border of the screen as soon as it gets close (Form1.Left<=30) to it. How can I do that?

Answer:

Use the WM_WindowPosChanging message:

procedure WMWindowPosChanging(var Message: TWMWindowPosChanging);
  message WM_WindowPosChanging;
{ ... }

procedure TForm1.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
  inherited;
  with Message.WindowPos^ do
    if x < 30 then
      x := 0;
end;

How to write bold text on a TStatusBar

Problem/Question/Abstract:

I need to write in bold or underlined in a statusbar. I have tried to use the owner draw options however I never get it right.

Answer:

Set the style property of the StatusPanel to psOwnerDraw and add following event handler:

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
var
  ts: TSize;
begin
  with StatusBar.Canvas do
  begin
    Font.Style := [fsBold];
    ts := TextExtent(Panel.Text);
    TextRect(Rect, 0, (Rect.Top + Rect.Bottom - ts.cy) div 2, Panel.Text);
  end;
end;

Adding Explorer MenuItem

Problem/Question/Abstract:

Creating Explorer MenuItem band object

Answer:

function AddMenuItem(ConnType: TconnType; MenuText, StatusBarText,
  GuidOrPath: string; HelpMenu: Boolean): string;
var
  GUID: TGUID;
  ID: string;
  Reg: TRegistry;
begin
  CreateGuid(GUID);
  ID := GuidToString(GUID);
  Reg := TRegistry.Create;
  with Reg do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey('\Software\Microsoft\Internet Explorer\Extensions\'
      + ID, True);
    if HelpMenu then
      WriteString('MenuCostumize', 'help');
    WriteString('CLSID', '{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}');
    WriteString('MenuText', MenuText);
    WriteString('MenuStatusBar', StatusBarText);
    case ConnType of
      EXECUTABLE: WriteString('Exec', GuidOrPath);
      COM_OBJECT: WriteString('ClsidExtension', GuidOrPath);
      SCRIPT: WriteString('Script', GuidOrPath);
    end;
    CloseKey;
    OpenKey('\Software\IE5Tools\Menu Items\', True);
    WriteString(MenuText, ID);
    CloseKey;
    Free;
  end;
  Result := ID;
end;

How to enhance TDBGrid performance in a slow ODBC connection

Problem/Question/Abstract:

I am using a TDBGrid through a slow ODBC connection to the data. When I scroll the grid it changes the selected row and takes an age to update all the "detail" queries run off it. The time it takes to update the "detail" queries wouldn't be a problem if I could scroll the grid and then select a new row once the one I want was in view. Any ideas?

Answer:

Don't use automatic linking, because it re-executes detail queries on every datachange. Instead, use manual linking with timer:


procedure Datasource1Datachange(...)
begin
  Timer1.Enabled := false;
  Timer1.Enabled := true;
end;


procedure Timer1Timer(..);
begin
  {details will be refreshed only when timer expires}
  DetailQ.Params[0].AsInteger := MasterQLinkField.AsInteger;
  DetailQ.Close;
  DetailQ.Open;
end;


I use timer interval from 300 - 500 ms. With this small trick you'll see a real performance boost.

Hidding or Missing IDE

Problem/Question/Abstract:

Occasionally in Delphi 5 the IDE will 'disappear'. This is to say you will launch Delphi, and most or all of your IDE will not be visible. Delphi is clearly running and working, as you can still use your hot keys and run and compile a program, you just can't see such useful items such as the object inspector or your component tool bar.

Answer:

This is caused by Delphi saving bogus information in its desktop preference files, or '.dsk' files. Delphi saves information about your environment options and settings in these files. In order to see your IDE again, all you need to do is delete these offending files. This will in no way harm Delphi or your project, as Delphi will dynamically generate these files as it needs them. You will however lose any environment settings that you had set previously.

How to copy all files from one directory to another (2)

Problem/Question/Abstract:

I would like to copy my work directory to H:\Backups and rename it to today's date, eg: H:\Backups\030801\

Answer:

procedure CopyTree(dir, dest: string);
var
  sfos: TSHFileOpStruct;
begin
  FillChar(sfos, SizeOf(sfos), 0);
  dir := dir + '\*.*'#0;
  dest := dest + '\*.*'#0;
  with sfos do
  begin
    wnd := 0;
    wfunc := FO_COPY;
    pFrom := PChar(dir);
    pTo := PChar(dest);
    fFlags := FOF_ALLOWUNDO or FOF_RENAMEONCOLLISION or FOF_SIMPLEPROGRESS;
    fAnyOperationsAborted := false;
    hNameMappings := nil;
    lpszProgressTitle := nil
  end;
  SHFileOperation(sfos)
end;


Create the destination directory with MkDir or ForceDirectories and call


CopyTree('c:\workdir', 'h:\backup\030801');


This will copy eventual subdirectories of c:\workdir too.

How to append formatted text to an existing formatted text in a TRichEdit component

Problem/Question/Abstract:

How to append formatted text to an existing formatted text in a TRichEdit component

Answer:

Project needs 3 TButtons, 1 TMemo, 1 TRichEdit, 1 TColorDialog, 1 TFontDialog, Uses RichEdit.

type
  TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte; cb: Longint;
    var pcb: Longint): DWORD; stdcall;
  TEditStream = record
    dwCookie: Longint;
    dwError: Longint;
    pfnCallback: TEditStreamCallBack;
  end;

function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint;
  var pcb: Longint): DWORD; stdcall;
var
  theStream: TStream;
  dataAvail: LongInt;
begin
  theStream := TStream(dwCookie);
  with theStream do
  begin
    dataAvail := Size - Position;
    Result := 0; {assume everything is ok}
    if dataAvail <= cb then
    begin
      pcb := Read(pbBuff^, dataAvail);
      if pcb <> dataAvail then {couldn't read req. amount of bytes}
        result := E_FAIL;
    end
    else
    begin
      pcb := Read(pbBuff^, cb);
      if pcb <> cb then
        result := E_FAIL;
    end;
  end;
end;

function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint;
  var pcb: Longint): DWORD; stdcall;
var
  theStream: TStream;
begin
  theStream := TStream(dwCookie);
  with theStream do
  begin
    if cb > 0 then
      pcb := Write(pbBuff^, cb);
    Result := 0;
  end;
end;

procedure GetRTFSelection(aRichEdit: TRichEdit; intoStream: TStream);
var
  editstream: TEditStream;
begin
  with editstream do
  begin
    dwCookie := Longint(intoStream);
    dwError := 0;
    pfnCallback := EditStreamOutCallBack;
  end;
  aRichedit.Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@editstream));
end;

procedure PutRTFSelection(aRichEdit: TRichEdit; sourceStream: TStream);
var
  editstream: TEditStream;
begin
  with editstream do
  begin
    dwCookie := Longint(sourceStream);
    dwError := 0;
    pfnCallback := EditStreamInCallBack;
  end;
  aRichedit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@editstream));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  aMemStream: TMemoryStream;
begin
  aMemStream := TMemoryStream.Create;
  try
    GetRTFSelection(richedit1, aMemStream);
    aMemStream.Position := 0;
    memo1.Lines.LoadFromStream(aMemStream);
  finally
    aMemStream.Free;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  aMemStream: TMemoryStream;
begin
  aMemStream := TMemoryStream.Create;
  try
    memo1.Lines.SaveToStream(aMemStream);
    aMemStream.Position := 0;
    PutRTFSelection(richedit1, aMemStream);
  finally
    aMemStream.Free;
  end;
end;

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if [ssCtrl] = Shift then
    case Key of
      Ord('B'): with (Sender as TRichEdit).SelAttributes do
          if fsBold in Style then
            Style := Style - [fsBold]
          else
            Style := Style + [fsBold];
      Ord('U'): with (Sender as TRichEdit).SelAttributes do
          if fsUnderline in Style then
            Style := Style - [fsUnderline]
          else
            Style := Style + [fsUnderline];
      Ord('I'): with (Sender as TRichEdit).SelAttributes do
          if fsItalic in Style then
            Style := Style - [fsItalic]
          else
            Style := Style + [fsItalic];
      Ord('T'): if ColorDialog1.Execute then
          (Sender as TRichEdit).SelAttributes.Color := ColorDialog1.Color;
      Ord('F'): if FontDialog1.Execute then
          (Sender as TRichEdit).SelAttributes.Assign(FontDialog1.Font);
    end;
end;

procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
begin
  {Ctrl-I yields a #9 character, a Tab. We have to swallow that.}
  if (Key = #9) and (GetKeyState(VK_CONTROL) < 0) then
    Key := #0;
end;

You now have a simple rich text editor and can type some formatted text into the rich edit. Select some of it and click button2. The selection is fetched and copied as RTF text into the memo. Put the caret somewhere in the rich edit and click button3. The RTF text from the memo is inserted at the selection into the rich edit. To combine several snippets of RTF text into one block one would have to remove the trailing } from block 1, the leading {\rtf1 from block 2 and copy both together into a new block. You can test that with a little cut and paste on the memo before you hit button3.

Parsing Strings using TParser

Problem/Question/Abstract:

Parsing Strings using TParser

Answer:

Delphi has a cool class called TParser that the IDE uses to parse the source code. You can also use it to parse strings.

This function takes a string argument and splits it into separate words for you.

procedure ParseThis(MyStr: string);
var
  MyParser: TParser;
  MS: TMemoryStream;
begin
  MS := TMemoryStream.Create;
  MS.Position := 0;
  MS.Write(MyStr[1], Length(MyStr));
  MS.Position := 0;
  MyParser := TParser.Create(MS);
  MyStr := MyParser.TokenString;
  ShowMessage(MyStr);
  while MyParser.Token <> toEOF do
  begin
    MyParser.NextToken;
    if MyParser.TokenSymbolIs(MyParser.TokenString) then
    begin
      MyStr := MyParser.TokenString;
      ShowMessage(MyStr);
    end;
  end;
  MyParser.Free;
  MS.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ParseThis('Now is the time for all men to come to the aid of their country.');
end;

How to resize a TPanel at runtime

Problem/Question/Abstract:

How to resize a TPanel at runtime

Answer:

You should add a SIZEBOX constant to the your panel window style:

TMyNewPanel = class(TPanel)
  { ... }
  procedure CreateParams(var Params: TCreateParams); override;
  { ... }

  procedure TMyNewPanel.CreateParams(var Params: TCreateParams);
  begin
    inherited CreateParams(Params);
    Params.Style := Params.Style or WS_SIZEBOX;
  end;

Modify a resource string at runtime

Problem/Question/Abstract:

How to modify a resource string at runtime

Answer:

{Modify a resourcestring constant:

Parameters:
Resstring is a pointer to a TResStringRec describing a resourcestring constant.
If this parameter is nil the function returns false.

Newvalue points to a zero-terminated string that should be the new value of the
resourcestring. This pointer must be guaranteed to stay valid for the lifetime of the
program! It should point to a constant string (a literal).

Returns true if the change was successful, false if not.
Precondition: newvalue <> nil
Will not work in Kylix! }

function ChangeResourceString(resstring: PResStringRec; newvalue: PChar): Boolean;
var
  oldprotect: DWORD;
begin
  Result := false;
{$IFDEF LINUX}

Thisfunction does not work in Kylix!{$ENDIF}
if resstring = nil then
  Exit;
Assert(Assigned(newvalue), 'ChangeResourceString: newvalue must be <> nil');
Result := VirtualProtect(resstring, Sizeof(resstring^), PAGE_EXECUTE_READWRITE,
  @oldProtect);
if Result then
begin
  resstring^.Identifier := Integer(newvalue);
  VirtualProtect(resstring, SizeOf(resstring^), oldProtect, @oldProtect);
end;
end;

Used like this:

resourcestring
  TestStr = 'Hello World';

procedure TForm1.Button1Click(Sender: TObject);
begin
  label1.caption := TestStr;
  ChangeResourceString(pResStringRec(@TestStr), 'Some test text');
  label2.caption := TestStr;
end;