Delete the clipboard content when the PrintScrn key is pressed

Problem/Question/Abstract:

How to delete the clipboard content when the PrintScrn key is pressed

Answer:

Solve 1:

This deletes anything on the clipboard if VK_SNAPSHOT was seen. There's only a small chance of getting something off the clipboard.

procedure TFormSlideShow.ApplicationIdle(Sender: TObject; var Done: Boolean);
begin
  {Get rid of anything on clipboard}
  if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then
    ClipBoard.Clear;
  Done := True;
end;


Solve 2:

You could use Win32 API functions to hook the Clipboard and intercept clipboard messages. I incorporated this into a form as follows:

uses
  Clipbrd;

TfrmViewer = class(TForm)
  procedure FormActivate(Sender: TObject);
  procedure FormDeactivate(Sender: TObject);
private
  fNextCB: THandle; {stored next handle in the clipboard chain}
  procedure WMDrawClipBoard(var Msg: TWMCopy); message WM_DRAWCLIPBOARD;
end;

procedure TfrmViewer.FormActivate(Sender: TObject);
begin
  fNextCB := SetClipBoardViewer(Handle);
end;

procedure TfrmViewer.FormDeactivate(Sender: TObject);
begin
  ChangeClipBoardChain(Handle, fNextCB);
end;

procedure TfrmViewer.WMDrawClipBoard(var Msg: TWMCopy);
{Intercepts the WM_DRAWCLIPBOARD message, which indicates that the contents of
the Windows clipboard have changed.  Then it empties the clipboard.  
This is to prevent users from doing a screen capture with the "PrintScreen" button.}
var
  i: Integer;
  numformat: Integer;
begin
  numformat := ClipBoard.FormatCount;
  if (numformat > 0) then
  begin
    for i := 0 to numformat - 1 do
      if (ClipBoard.Formats[i] = CF_BITMAP) or (ClipBoard.Formats[i] = CF_DIB) then
        ClipBoard.Clear;
  end;
end;

The clipboard hook is set in the form's OnActivate event and unhooked in the OnDeactivate event. The message handler checks for a bitmap format in the clipboard, and if it finds it, the clipboard gets cleared. This effectively captures both "Printscreen" and "ALT + PrintScreen". You do need to keep a couple of things in mind though: If other programs are running that use Copy/ Cut/ Paste functions, anything that these programs copied to the clipboard will also get cleared. There are other methods that can be used to do screen captures that do not involve either the "PrintScreen" key or the Clipboard, and they are more difficult to prevent, short of disabling all other running applications or adversely affecting the performance of your own application.

How to detect a double-click in a column of a TDBGrid

Problem/Question/Abstract:

When a user double-clicks on a DBGrid, how can I tell which column they were double-clicking on? Or does that double-click only apply to an entire row? I'd like to set that field to toggle values everytime the user double-clicks.

Answer:

procedure TForm1.DBGrid1DblClick(Sender: TObject);
var
  pt: TPoint;
  gc: TGridCoord;
begin
  GetCursorPos(pt);
  with Sender as TDBGrid do
  begin
    pt := ScreenToClient(pt);
    gc := MouseCoord(pt.x, pt.y);
    if Columns[gc.X - 1].Color = clRed then
      Columns[gc.X - 1].Color := clBlue
    else
      Columns[gc.X - 1].Color := clRed;
  end;
end;

No need for the "hack" class technique here, though that also works.

Logon and Impersonate another NT User Account (NT/2000 Only)

Problem/Question/Abstract:

How can I impersonate another NT User account at runtime so my process is recognised as the impersonated user.

Answer:

There are many different reason you might need to run an application/server as a different user, so you can perform tasks on behalf of that user account, or obtain privileges of that user so as to beable to perform specified tasks.
i.e File/Network access, registry etc..

Logging on as a different user from an application, and impersonating that user is not a differcult task by use of API calls provide, but many people miss the security side to this and fail to realize the requirement for NT security privileges, and how to assign those security rights to them selves to allow
them to do a Logon.
The call LogonUser requires the privilege of SE_TCB_NAME which requires you to have the right "Act as part of the Operating System" assigned to your user account before you can Logon as a different user.
Through NT this is done through local user manager, and on 2000 is done through computer local policy control etc..
Ask your Technical administrator for details on assigning Security Rights to users.!

Once you have assigned your self the right of "Act as part of the Operating System" you automatically have rights to call the LogonUser api call.

Note: For those who know about NT privileges and setting the enable flag to
privileges, you don't need to set the privilege all that is required is that yhou have the privilege available to you.

So here is how it is done.

var
  hToken: Cardinal;

function PerformLogon(const User, Domain, Password: string): Cardinal;
begin
  if not LogonUser(pChar(User), pChar(Domain), pChar(Password),
    LOGON32_LOGON_NETWORK,
    LOGON32_PROVIDER_DEFAULT,
    Result) then
    RaiseLastWin32Error;
end;

begin
  hToken := PerformLogon('Chris', 'DelphiDomain', 'MyPassword');
  try
    ImpersonateLoggedOnUser(hToken);
    try
      (* Perform tasks as User. *)
    finally
      RevertToSelf;
    end;
  finally
    CloseHandle(hToken);
  end;
end;

Well that is pretty much it, however.. note that LogonUser is only passing you an impersonation token, and not a primary token in this instance. You can use the api calls DuplicateTokenEx, or CreateProcessAsUser which can help with creating Primary Tokens...

Also note that, when your impersonation is required to pass over to the authentication of COM for example, this method will not work on it's own.
I have published an article which details authentication and impersonation for COM authentication. Refer to :
  
Specifing authentication details & Impersonating a user for use on an Interface(Proxy)call (Client Side)

How to split and concatenate lines of strings in a file

Problem/Question/Abstract:

I have a disk file with lines of 80 character length. I want to concatenate all these lines in one and later split them again into 80 character lines. How can I do this?

Answer:

function GetOneString(const FilePath: string): string;
var
  List: TStringList;
  i: Integer;
begin
  Result := '';
  List := TStringList.Create;
  try
    try
      list.LoadFromFile(FilePath);
    except
    end;
    for i := 0 to List.Count - 1 do
      Result := Result + List[i];
  finally
    list.free;
  end;
end;

To save to a file:

procedure SaveStrings(const FilePath: string; const Num: Integer; St: string);
{FilePath: Name of file to save string / Num: Width of strings, 80 in your case / St: String to save}
var
  f: system.text;
  i: Integer;
begin
  assignfile(f, FilePath);
  rewrite(f);
  i := 0;
  while ((i + Num) <= Length(st)) do
  begin
    writeln(f, copy(st, i + 1, Num));
    inc(i, Num);
  end;
  inc(i);
  if (i < Length(st)) then
  begin
    Writeln(f, copy(st, i, Num));
  end;
  closefile(f);
end;

A TStringList has some properties like Text and Commatext which return the complete strings separated by CRLF (CarriageReturn and Line Feed) and ',' respectively, therefore you could use any of these to access the strings without wasting extra resources.

Create functions that can accept variable number of parameters such as Format()

Problem/Question/Abstract:

How to create functions that can accept variable number of parameters such as Format()

Answer:

Sometimes it's necessary to pass undefined number of [different type] variables to a function -- look at Format() function in Delphi and *printf() functions in  C/C++ for example. Once you analyze the following code, you'll be on your way to creating mysterious variable parameter functions...

// FunctionWithVarArgs()
//
// skeleton for a function that
// can accept vairable number of
// multi-type variables
//
// here are some examples on how
// to call this function:
//
// FunctionWithVarArgs(
//   [ 1, True, 3, '5', '0' ] );
//
// FunctionWithVarArgs(
//   [ 'one', 5 ] );
//
// FunctionWithVarArgs( [] );
//

procedure FunctionWithVarArgs(
  const ArgsList: array of const);
var
  ArgsListTyped:
  array[0..$FFF0 div SizeOf(TVarRec)]
    of TVarRec absolute ArgsList;
  n: integer;
begin
  for n := Low(ArgsList) to
    High(ArgsList) do
  begin
    with ArgsListTyped[n] do
    begin
      case VType of
        vtInteger:
          begin
            {handle VInteger here}
          end;
        vtBoolean:
          begin
            {handle VBoolean here}
          end;
        vtChar:
          begin
            {handle VChar here}
          end;
        vtExtended:
          begin
            {handle VExtended here}
          end;
        vtString:
          begin
            {handle VString here}
          end;
        vtPointer:
          begin
            {handle VPointer here}
          end;
        vtPChar:
          begin
            {handle VPChar here}
          end;
        vtObject:
          begin
            {handle VObject here}
          end;
        vtClass:
          begin
            {handle VClass here}
          end;
        vtWideChar:
          begin
            {handle VWideChar here}
          end;
        vtPWideChar:
          begin
            {handle VPWideChar here}
          end;
        vtAnsiString:
          begin
            {handle VAnsiString here}
          end;
        vtCurrency:
          begin
            {handle VCurrency here}
          end;
        vtVariant:
          begin
            {handle VVariant here}
          end;
      else
        begin
          {handle unknown type here}
        end;
      end;
    end;
  end;
end;

//
// example function created using
// the above skeleton
//
// AddNumbers() will return the
// sum of all the integers passed
// to it
//
// AddNumbers( [1, 2, 3] )
//   will return 6
//
//

function AddNumbers(
  const ArgsList: array of const)
  : integer;
var
  ArgsListTyped:
  array[0..$FFF0 div SizeOf(TVarRec)]
    of TVarRec absolute ArgsList;
  n: integer;
begin
  Result := 0;
  for n := Low(ArgsList) to
    High(ArgsList) do
  begin
    with ArgsListTyped[n] do
    begin
      case VType of
        vtInteger: Result := Result + VInteger;
      end;
    end;
  end;
end;

How can I create a system wide keyboard hook under Win32?

Problem/Question/Abstract:

How can I create a system wide keyboard hook under Win32?

Answer:

I found the following code posted in a newsgroup. Since it is asked frequently, I add it here.

Comments:

The following example demonstrates creating a system wide windows hook under Win32. The example provides both the code for the system hook dll and an example application. The hook function that we will create will also demonstrate advanced coding techniques such as sharing global memory across process boundaries using memory mapped files, sending messages from the key hook function back to the originating application, and dynamic loading of a dll at runtime.

The example keyboard hook that we create will keep a count of the number of keystrokes a user enters on the keyboard. Further, we will demonstrate trapping the enter key, and passing a message back to the application that initiated the keyboard hook each time the enter key is pressed. Finally, we will demonstrate trapping the left arrow key and instead of letting it through to the current application, we will instead replace it with a right arrow keystroke. (Note: that this can cause much confusion to a unsuspecting user).


library TheHook;

uses
  Windows, Messages, SysUtils;

{Define a record for recording and passing information process wide}
type
  PHookRec = ^THookRec;
  THookRec = packed record
    TheHookHandle: HHOOK;
    TheAppWinHandle: HWnd;
    TheCtrlWinHandle: HWnd;
    TheKeyCount: DWord;
  end;

var
  hObjHandle: THandle; {Variable for the file mapping object}
  lpHookRec: PHookRec;
  {Pointer to our hook record}

procedure MapFileMemory(dwAllocSize: DWord);
begin { MapFileMemory }
  {Create a process wide memory mapped variable}
  hObjHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
    dwAllocSize, 'HookRecMemBlock');
  if (hObjHandle = 0) then
  begin
    MessageBox(0, 'Hook DLL', 'Could not create file map object', mb_Ok);
    exit
  end { (hObjHandle = 0) };
  {Get a pointer to our process wide memory mapped variable}
  lpHookRec := MapViewOfFile(hObjHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
  if (lpHookRec = nil) then
  begin
    CloseHandle(hObjHandle);
    MessageBox(0, 'Hook DLL', 'Could not map file', mb_Ok);
    exit
  end { (lpHookRec = Nil) }
end; { MapFileMemory }

procedure UnMapFileMemory;
begin { UnMapFileMemory }
  {Delete our process wide memory mapped variable}
  if (lpHookRec <> nil) then
  begin
    UnMapViewOfFile(lpHookRec);
    lpHookRec := nil
  end { (lpHookRec <> Nil) };
  if (hObjHandle > 0) then
  begin
    CloseHandle(hObjHandle);
    hObjHandle := 0
  end { (hObjHandle > 0) }
end; { UnMapFileMemory }

function GetHookRecPointer: pointer
  stdcall;
begin { GetHookRecPointer }
  {Return a pointer to our process wide memory mapped variable}
  Result := lpHookRec
end; { GetHookRecPointer }

{The function that actually processes the keystrokes for our hook}

function KeyBoardProc(code: Integer; wParam: Integer; lParam: Integer):
  Integer;
  stdcall;
var
  KeyUp: bool;
  {Remove comments for additional functionability
    IsAltPressed : bool;
    IsCtrlPressed : bool;
    IsShiftPressed : bool;
   }
begin { KeyBoardProc }
  Result := 0;

  case code of
    HC_ACTION:
      begin
        {We trap the keystrokes here}
        {Is this a key up message?}
        KeyUp := ((lParam and (1 shl 31)) <> 0);

        (*Remove comments for additional functionability
       {Is the Alt key pressed}
        if ((lParam and (1 shl 29)) <> 0) then begin
          IsAltPressed := TRUE;
        end else begin
          IsAltPressed := FALSE;
        end;

       {Is the Control key pressed}
        if ((GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0) then begin
          IsCtrlPressed := TRUE;
        end else begin
          IsCtrlPressed := FALSE;
        end;

       {if the Shift key pressed}
        if ((GetKeyState(VK_SHIFT) and (1 shl 15)) <> 0) then begin
          IsShiftPressed := TRUE;
        end else begin
          IsShiftPressed := FALSE;
        end;
       *)
        {if KeyUp then increment the key count}
        if (KeyUp <> false) then
        begin
          inc(lpHookRec^.TheKeyCount)
        end { (KeyUp <> false) };

        case wParam of
          {Was the enter key pressed?}
          VK_RETURN:
            begin
              {if KeyUp}
              if (KeyUp <> false) then
              begin
                {Post a bogus message to the window control in our app}
                PostMessage(lpHookRec^.TheCtrlWinHandle, WM_KEYDOWN, 0, 0);
                PostMessage(lpHookRec^.TheCtrlWinHandle, WM_KEYUP, 0, 0)
              end { (KeyUp <> false) };
              {if you wanted to swallow the keystroke then return -1}
              {else if you want to allow the keystroke then return 0}
              Result := 0;
              exit
            end; {VK_RETURN}
          {if the left arrow key is pressed then lets play a joke!}
          VK_LEFT:
            begin
              {if KeyUp}
              if (KeyUp <> false) then
              begin
                {Create a UpArrow keyboard event}
                keybd_event(VK_RIGHT, 0, 0, 0);
                keybd_event(VK_RIGHT, 0, KEYEVENTF_KEYUP, 0)
              end { (KeyUp <> false) };
              {Swallow the keystroke}
              Result := -1;
              exit
            end; {VK_LEFT}
        end { case wParam }; {case wParam}
        {Allow the keystroke}
        Result := 0
      end; {HC_ACTION}
    HC_NOREMOVE:
      begin
        {This is a keystroke message, but the keystroke message}
        {has not been removed from the message queue, since an}
        {application has called PeekMessage() specifying PM_NOREMOVE}
        Result := 0;
        exit
      end;
  end { case code }; {case code}
  if (code < 0) then
    {Call the next hook in the hook chain}
    Result := CallNextHookEx(lpHookRec^.TheHookHandle, code, wParam, lParam)
end; { KeyBoardProc }

procedure StartKeyBoardHook
  stdcall;
begin { StartKeyBoardHook }
  {if we have a process wide memory variable}
  {and the hook has not already been set...}
  if ((lpHookRec <> nil) and (lpHookRec^.TheHookHandle = 0)) then
  begin
    {Set the hook and remember our hook handle}
    lpHookRec^.TheHookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyBoardProc,
      HInstance, 0)
  end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) }
end; { StartKeyBoardHook }

procedure StopKeyBoardHook
  stdcall;
begin { StopKeyBoardHook }
  {if we have a process wide memory variable}
  {and the hook has already been set...}
  if ((lpHookRec <> nil) and (lpHookRec^.TheHookHandle <> 0)) then
  begin
    {Remove our hook and clear our hook handle}
    if (UnHookWindowsHookEx(lpHookRec^.TheHookHandle) <> false) then
    begin
      lpHookRec^.TheHookHandle := 0
    end { (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) }
  end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) }
end; { StopKeyBoardHook }

procedure DllEntryPoint(dwReason: DWord);
begin { DllEntryPoint }
  case dwReason of
    Dll_Process_Attach:
      begin
        {if we are getting mapped into a process, then get}
        {a pointer to our process wide memory mapped variable}
        hObjHandle := 0;
        lpHookRec := nil;
        MapFileMemory(sizeof(lpHookRec^))
      end;
    Dll_Process_Detach:
      begin
        {if we are getting unmapped from a process then, remove}
        {the pointer to our process wide memory mapped variable}
        UnMapFileMemory
      end;
  end { case dwReason }
end; { DllEntryPoint }

exports
  KeyBoardProc name 'KEYBOARDPROC',
  GetHookRecPointer name 'GETHOOKRECPOINTER',
  StartKeyBoardHook name 'STARTKEYBOARDHOOK',
  StopKeyBoardHook name 'STOPKEYBOARDHOOK';

begin
  {Set our Dll's main entry point}
  DLLProc := @DllEntryPoint;
  {Call our Dll's main entry point}
  DllEntryPoint(Dll_Process_Attach)
end.

Cannot access package information for package

Problem/Question/Abstract:

I am attempting to install a new package under Delphi 5 and I get the following error message:
"Cannot access package information for package"

I use Delphi 5 with service pack 1. The package itself compiles without problems until it yields the message above. I get the same problem when trying to install two different packages.
The computer I am working on runs Windows NT 4.0, service pack 6A.

Answer:

Sometimes happens that one of files produced by compiler is corrupted. And usually this is reflected on dependent packages.

Before 'Cannot access package ...' the status window shows other compile/link error. This should give you some idea what is wrong.

If the package depends on other custom packages, rebuild them first.

If it does not help, delete their associated .DCP files and try again 2.)

If it still does not help, delete the .DCU files, reboot and try again 3.)

Good luck!

Enumerate Modems

Problem/Question/Abstract:

How to enumerate modems?

Answer:

uses registry;

function EnumModems: TStringList;
var
  R: TRegistry;
  s: ShortString;
  N: TStringList;
  i: integer;
  j: integer;
begin
  Result := TStringList.Create;
  R := TRegistry.Create;
  try
    with R do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey('\System\CurrentControlSet\Services\Class\Modem', False) then
        if HasSubKeys then
        begin
          N := TStringList.Create;
          try
            GetKeyNames(N);
            for i := 0 to N.Count - 1 do
            begin
              OpenKey(N[i], False);
              s := ReadString('AttachedTo');
              for j := 1 to 4 do
                if Pos(Chr(j + Ord('0')), s) > 0 then
                  Break;
              Result.AddObject(ReadString('DriverDesc'), TObject(j));
              CloseKey;
            end;
          finally
            N.Free;
          end;
        end;
    end;
  finally
    R.Free;
  end;
end;

Turning images on/off in Internet Explorer

Problem/Question/Abstract:

Turning images on/off in Internet Explorer

Answer:

You can disable downloading images in IE using the registry. The setting will effect future IE instances or as soon as the user opens the OPTIONS dialog.

Many other interesting flags can be found under

  \Software\Microsoft\Internet Explorer\

Call the function below as

  SetIE_DisplayInlineImages(false);


procedure SetIE_DisplayInlineImages(bDisplay: boolean);
const
  DisplayInlineImages = 'Display Inline Images';
var
  sTmp: string;
begin
  with TRegistry.Create do
  begin
    RootKey := HKEY_CURRENT_USER;
    OpenKey('\Software\Microsoft\Internet Explorer\Main', True);
    if bDisplay then
      sTmp := 'yes'
    else
      sTmp := 'no';
    WriteString(DisplayInlineImages, sTmp);
    Free;
  end { with TRegistry.Create };
end;

Lock floppy drive functions

Problem/Question/Abstract:

How can I lock a floppy drive so that it cannot access system functions like copy, move between hard disks etc.?

Answer:

The following code works for WinNT. You may need to enclose the main calls (CreateFile, DeviceIoControl, CloseHandle) inside a loop with a sleep interval because it fails sometimes.

{ ... }
const
  FILE_DEVICE_FILE_SYSTEM: Integer = $00000009;
  METHOD_BUFFERED: Integer = $00000000;
  FILE_ANY_ACCESS: Integer = $00000000;
  { ... }

function CTL_CODE(DeviceType, FunctionNo, Method, Access: Integer): Integer;
begin
  Result := (DeviceType shl 16) or (Access shl 14) or (FunctionNo shl 2) or (Method);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  LHandle: THandle;
  BytesReturned: Cardinal;
  MsgBuf: PChar;
  FSCTL_LOCK_VOLUME: Integer;
begin
  FSCTL_LOCK_VOLUME := CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 6,
    METHOD_BUFFERED, FILE_ANY_ACCESS);
  LHandle := CreateFile('\\.\A:', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ
    or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
    FILE_FLAG_DELETE_ON_CLOSE, 0);
  if LHandle <> 0 then
  begin
    if DeviceIOControl(LHandle, FSCTL_LOCK_VOLUME, nil, 0, nil, 0, BytesReturned, nil)
      then
      ShowMessage('Drive locked. Press OK to unlock.')
    else
    begin
      if FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or
        FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError(), 0, @MsgBuf, 0, nil) > 0 then
      begin
        ShowMessage('DeviceIOControl failed: ' + MsgBuf);
        LocalFree(Cardinal(MsgBuf));
      end
      else
        ShowMessage('DeviceIOControl failed!');
    end;
    CloseHandle(LHandle);
  end
  else
    ShowMessage('CreateFile failed!');
end;

Implement an OnEndResize event for a TForm

Problem/Question/Abstract:

Any idea how to implement an OnEndResize event for TForm? Obviously, it should be fired when the user finishes resizing the form.

Answer:

You'll need to handle WM_SYSCOMMAND and WM_EXITSIZEMOVE. Here's a framework to get you started:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
  private
    { Private declarations }
    FSizing: Boolean;
    procedure WMEnterSizeMove(var AMessage: TMessage); message WM_ENTERSIZEMOVE;
    procedure WMExitSizeMove(var AMessage: TMessage); message WM_EXITSIZEMOVE;
    { procedure WMSize(var AMessage: TMessage); message WM_SIZE; }
    procedure WMSysCommand(var AMessage: TMessage); message WM_SYSCOMMAND;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMSysCommand(var AMessage: TMessage);
begin
  if (AMessage.WParam and $FFF0) = SC_SIZE then
  begin
    FSizing := true;
    ListBox1.Items.Add(Format('SysCommand called - message: %d:%d',
      [AMessage.WParam, AMessage.LParam]));
  end;
  inherited; {Note: inherited after testing for SC_SIZE}
end;

procedure TForm1.WMExitSizeMove(var AMessage: TMessage);
begin
  inherited;
  ListBox1.Items.Add(Format('ExitSizeMove called - message: %d:%d',
    [AMessage.WParam, AMessage.LParam]));
  if FSizing then
  begin
    {Do your stuff here}
    FSizing := false;
  end;
end;

procedure TForm1.WMEnterSizeMove(var AMessage: TMessage);
begin
  inherited;
  ListBox1.Items.Add(Format('EnterSizeMove called - message: %d:%d',
    [AMessage.WParam, AMessage.LParam]));
end;

{
procedure TForm1.WMSize(var AMessage: TMessage);
begin
  inherited;
  ListBox1.Items.Add(Format('Size called - message: %d:%d', [AMessage.WParam,
                                      AMessage.LParam]));
  FSizing := true;
end;
}

end.

DialogUnits To Pixels

Problem/Question/Abstract:

How to convert dialogs units in pixels if the dialog do not use system font

Answer:

function DialogUnitsToPixels(DialogUnits: Integer; Canvas: TCanvas; Font: TFont):
  Integer;
var
  A: array[0..52] of char;
  Z: Integer;
  U: Word;
begin
  // select the current font
  SelectObject(Canvas.Handle, Font.Handle);
  // Get DialogBaseUnit for system font
  U := HiWord(GetDialogBaseUnits) div 4;
  // compute mean width of characters in current font
  // as recommended by Microsoft
  A := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  Z := (Canvas.TextWidth(A) div 26 + 1) div 2;
  // Compute result and adjust for screen resolution
  Result := DialogUnits * Z div U * Screen.PixelsPerInch div 96;
end;

Why can't my ISAPI DLL created in Delphi 3 handle multiple connections

Problem/Question/Abstract:

Why can't my ISAPI DLL created in Delphi 3 handle multiple connections

Answer:

Although the ISAPI DLL wizard in Delphi 3 creates a DLL that is multi-thread safe, there is an omission in the source code which fails to set a flag telling the application that the DLL is multi-thread safe. This shortcoming can be overcome by simply adding the line: IsMultiThread := TRUE; as the first line of your DPR's begin-end block.

Copyright (c) 2001 Ernesto De Spirito
Visit: http://www.latiumsoftware.com/delphi-newsletter.php

How to register your own clipboard format

Problem/Question/Abstract:

I want to write raw bytes to the clipboard, but the only functions the TClipboard component offers are SetText, SetAsHandle and SetComponent. Well, I need to set these bytes as a certain format (566 to be exact), so that rules out SetText. SetAsHandle didn't seem to work when I tried it, and I have no idea how SetComponent would do anything for me. The help files included with Delphi (6) weren't overly helpful in explaining how to use this class in any way, other than copying text and pictures.

Answer:

Here is an example:

uses
  Clipbrd;
const
  MyFormatName = 'My Junk Clipboard Format';
  MySource: PChar = 'hello';
var
  MyFormat: Word;
  MySize: Integer;
  MyMemory: THandle;
  MyBuffer: Pointer;
begin
  MyFormat := RegisterClipboardFormat(MyFormatName);
  {Determine the size of the data to be copied.
        StrLen does not count the null terminator.
  So add one byte to be sure it will be pasted correctly as PChar.}
  MySize := StrLen(MySource) + 1;
  {Allocate memory for passing data to the clipboard.}
  MyMemory := GlobalAlloc(GMEM_MOVEABLE, MySize);
  try
    {Copy data to the memory}
    MyBuffer := GlobalLock(MyMemory);
    try
      Move(MySource^, MyBuffer^, MySize);
    finally
      GlobalUnlock(MyMemory);
    end;
    {Call TClipboard.SetAsHandle}
    Clipboard.SetAsHandle(MyFormat, MyMemory);
  except
    GlobalFree(MyMemory);
    raise;
  end;
end;

How to avoid flicker when moving or sizing a MDI child form (2)

Problem/Question/Abstract:

I have a MDI application which maximizes the client forms as they are created. On Win9x I can stop the initial flash of the MDI child form being created by using LockWindowUpdate(Handle). However on Win XP this code doesn't work as predicted. The form updating is turned off, but the client form still draws its outline briefly in the MDI client space. So, does anyone know how I can get round this on Win XP?

Answer:

{ ...}
TForm1 = class(TForm)
private
  fLockClientUpdateCount: Integer;
public
  constructor Create(aOwner: TComponent); override;
  procedure LockClientUpdate;
  procedure UnlockClientUpdate;
end;

{ ... }

constructor TForm1.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  fLockClientUpdateCount := 0;
end;

procedure TForm1.LockClientUpdate;
begin
  if fLockClientUpdateCount = 0 then
    SendMessage(ClientHandle, WM_SETREDRAW, 0, 0);
  Inc(fLockClientUpdateCount);
end;

procedure TForm1.UnlockClientUpdate;
begin
  Dec(fLockClientUpdateCount);
  if fLockClientUpdateCount = 0 then
  begin
    SendMessage(ClientHandle, WM_SETREDRAW, 1, 0);
    RedrawWindow(ClientHandle, nil, 0, RDW_FRAME or RDW_INVALIDATE or
      RDW_ALLCHILDREN or RDW_NOINTERNALPAINT)
  end;
end;

Now, simply call LockClientUpdate and UnlockClientUpdate instead of LockWindowUpdate.

Anti Cracking FAQ

Problem/Question/Abstract:

Anti Cracking FAQ
How to make cracking your programs a little harder
Richey's DELPHI-BOX  (http://www.inner-smile.com)

Answer:

Contents
How to make cracking your app a little bit harder...
More tips you might take into consideration...
Advanced tips given by Assembler freaks...
Special on Delphi reverse engineering...
Some notes on registration numbers...
Some notes on timebombs...
How to find cracks for your apps...
What to do if you found a crack for your app...
Facts and Myths about Software pirating...

Finding out that the program on which you worked for months or years has been cracked can really hurt and demotivate.
For me as a Shareware programmer, the reason has never been that I've lost a few cents (I don't want to do probability calculations here, it might hurt even more..), no, it was simply that I've always tried to hold my programs as cheap as possible to make them affordable for everyone, even for students or freeware programmers.
Somehow I can understand the fascination of cracking programs (if you are absolutely intolerant about software crackers and hackers, please excuse, but one of my educations is Psychotherapy, and I'm always searching for psychological reasons...) - cracking a restricted software program must be like solving a (sometimes very tricky) riddle, and you might get addicted to the feeling of solving them (I've found that when I saw my grandmother doing crossword puzzles all over the time for some months). The problem is (but at the latest, now we come to the undoubtedly illegal part of the "game"): it doesn't really satisfy the cracker if he is the the only one who knows about his "genius"...thus, he has to spread the news. He has to publish his "crack" (just see most crack packages: in most cases they just consist of: 1. the cracking utility 2. a short description 3. a big text file or even animation containing claims that the producers are nothing less than the most brilliant individuals on Earth and that the cracked program is another one which could not stop them due to "its lame protection scheme".)
But now the fun is completely over: by giving out this (let's try to be fair: "study of feasibility") to other people, by spreading it via Websites, newsgroups, mailing lists, anonymous FTP, CDROM "abonnements" and whatever, they clearly damage the business of everyone who puts time and energy in their software product. Even if we assume that typical crackers wouldn't have bought your product under normal circumstances: spreading the "crack" IS criminal and no one could claim that none of the receivers or downloaders would never have bought it. It's just like if someone hands out copies of the key to your car on the marketplace - and it doesn't really matter if he does that for money or not.
In earlier days, I have never put real energy in protecting my programs against cracking, but after finding several cracks for them around, I thought to myself: why make it too easy? As a programmer, of course I know that no - really: NO! - program can ever be crack-safe, and I know that of every interesting program sooner or later cracks (or at least pirated or illegally copied versions) will be around, but at least I could try to avoid the worst mistakes. Crackers are not super-geniuses .. they are simple programmers who have learned some techniques to counteract common protection schemes - and if you know where and how crackers are searching, you can make them lose *much* time! And that's what it is about: there is no bullet-proof way to protect your programs, but you can dance on the nerves of those people until they decide for an easier target to "get the feeling"... or even go outside to enjoy the nature instead of sitting in front of the monitor the whole day. ;-)
Most of the typical 'high language' programmers don't know Assembler anymore, so the 'protection ideas' they use are in most cases quite weak.
I don't know much about Assembler myself, so I decided to open my eyes and started to collect anti-crack protection tips wherever I found them. Also I did my best to "learn from the other side" .. many of the tips you can find here I've found by studying the typical cracking techniques, the various "cracking guides" around the web and by reading protection tips given even by professional crackers themselves (some of them generously give us tips to increase their challenge). Well, I hope I've learned my lessons well enough, but also want to share my experiences with you on this page.
Some rules given here were already stated in various essays on other sites, but are listed here for completeness. Many of these apply especially to Windoze, but can be "ported" to other OS'es or anywhere else.
PLEASE:
This FAQ is just as good as the experiences that are webbed into it. If you think that I've missed some points or useful tips a typical developer could easily add to his/her programs to improve protection, please let me know. If you allow, then I'll add it here, otherwise I'll inform you about my experiences with it.
Don't ask me questions - might be that I'm simply too overburden to answer.
1) as mentioned, I don't have much knowledge of the low-level stuff.
2) I can't send you demo sources, since I don't have anything ready for a publication. If I have something, you will read it here.
3) finally, I will not provide anyone with any of the URLs where I've found (or found out) some of these tips. Please understand, but this is a site dedicated to programming, but not to provide "step-in's" to available cracks or even to generic "Cracker hunting".
But finally, here is..

How to make cracking your app a little bit harder:
(tips are not sorted by  importance)

Never use meaningful procedure names such as

    function RegistrationOK: Boolean;
        
How intelligent and complex your code inside this function might ever be - an experienced cracker will just take about 10-20 seconds to remove it. Believe it or not.
Alternatively, place some required code for your program in such a function. If the cracker disables the function, your program would produce incorrect results, for example.

Avoid nagscreens or "Gotcha!" messages - this is what crackers are searching first. They will never dig through the 300K ASM instructions of your program - instead, they are first searching the location of nag screens or your "Your evaluation time has expired!" message and start cracking there (see below for more tips about that). In some cases, it's even enough to remove the form resource from the EXE and it will show no nag screen anymore - without any bug showing up! If you really need such a nag screen, you should build it dynamically at runtime, and generally, the only method to show the user that he is unregistered should be in the "about" dialog (some programmers also have the philosophy that nag screens might cause your users to hate your app which would then also be very stupid).

Never use meaningful file names such as License.Dat. Why, you say? Please start reading here. :)

Play with asymmetric encryption. Just using unusual filenames is often not enough. Good encryption, of course, could keep the cracker busy for months (if he likes).

Add long delays. Don't warn the user right after a violation is made. Wait later, maybe until the next day or two (crackers hate that).

Add short delays. Pause a second or two after a password entry or to your other checking routines to make brute force cracking unfeasible. Simple to do, but rarely done.

Use checksums in DLL's and in the EXE. Have them check each other. Far away from "safe", but it just makes it harder to crack.

Self-heal your software. You know, things like the error correction modems and hard drives use. The technology has been around for years, and no one uses it on their software? The best thing about this is that if the cracker used a decompiler, they may be looking at a listing that is no longer valid.

Patch your own software! Change your code to call different validation routines each time. Beat them at their own game.

Store serial numbers in unlikely places like as a property of a database field. Often heard and read: "..give it a DLL file name and store it in the System directory." Too often heard, don't use it. ;-)

Store serial numbers in several places.

Don't use literal strings that tell the user: "Sorry, but... (whatever)." These are the first things to look for. Build strings dynamically or encrypt them.

Flood the cracker with bogus calls and hard-coded strings. Decoys are fun.

Have fun with Spaghetti-Code simply eats his time and nerves..

Say goodbye to time limits. ..find detailed tips in the related section down on this page.

Don't use a validation functions. Every time you validate the user, write your validation code inline with the current process. That just makes more cracking for the cracker and bewares of just NUL'ing out your routine.

Use "reserved" names. When using hard-coded keys or passwords, make them look like program code or function calls (i.e., "73AF" or "GetWindowText"). This actually works very well and confuses some decompilers.

No "disabled" features. If your program doesn't save data in "crapware" edition, don't include a "grayed" menu item. No saving means no saving - the code should not be included in the EXE - that's it. Most programming languages offer you a really easy way to maintain several versions of your code by simply doing the following:

        {$IFDEF trial}
                                ... no action here ...
                                {$ELSE}
                                ... advanced functionality for registered user ...
                                {$ENDIF}
        
Release several, slightly modified versions.
        
        {$IFDEF Anticrack_Method36}
                                ..protection code #36 comes here..
                                {$ENDIF}
        
By doing the an adapted variation of the tip mentioned before, you can easily vary your code and enable/disable it (by defining or undefining the related DEFINE variable) to create slightly different versions of your program executables. This will keep the crackers busy since many of their fellow fans will repeatedly tell them that "crack xy is not working!!!" if they just downloaded the program from somewhere else than the cracker himself did it. Either the software pirates would now be forced to create a number of cracks for each "build", to fill up their server space with a complete setup package of one of your builds along with the crack which works on it or simply to give up on your program.
btw., this is also a cool method to make a special build for your registered users or preventing "registered" code to be compiled into the officially downloadable demo release (which crackers can often "enable" with just a few minutes of works as explained elsewhere on this page).

Update often. Frequent updates mean: frequently changing code, so the typical (simple) crack which is just patching hard-coded byte positions, will possibly already be outdated when published. Also prevent uploading them to public servers, so that you have better control about where your app sits around and people don't find older versions the cracks can still use. Yes, this doesn't prevent pirates from including the version to the crack package, but IF they do so, you can at least contribute to filling up their hard disks.

Create special temporary unlock codes, that work only for a limited amount of time (say 15-30 days). Send this code immediately upon registration .. then wait a bit (e.g., for the credit charge to be validated). Only then send the unlimited code. That way, the "cracker" will not know that something is wrong and happilly post his code to the warez sites. By the time it spreads, the code will have stopped working. Thus making a fool of the "cracker" amongst his friends for distributing non-working codes. This is a method also handy for beta testers or reviewers.

Use strong encryption. Just XORing is not really strong - use something with an algorithm that isn't easily reverse-engineered, and don't put both encryption and decryption code in your app.

Some thoughts about hardware-based protection: Many tips concerning software protection include retrieving hardware information from the user's machine (like the hard disk number, checksums of certain BIOS areas or other system variables). Once calculated, you could save these numbers and just run your program or enable certain features if they match on the computer. Or you could create an encrypted/mangled list of data containing this data and let the user send it to you, then create a machine-specific unlocking code and send it back to the user. Everything quite nice from a protection point of view (if you also keep the other tips on this page in mind, of course: not even the best technique protects against weak validity checks), however, it requires continuous contacts with your end-users and might not be the preferred method especially of developers who have a bigger number of users. Every time your user changes his hard disk, buys a new computer or upgrades his system in another way you would have to interact with him, or - if he purchased your program already some months ago - he might even send you an angry mail "why your program doesn't work anymore" .. you should take this into consideration before deciding for hardware-based protection.

Finally, take some time to think about protecting your software. Is it really worth the protection? Wouldn't it be better to improve your software, rather than improving protections? The problem of protecting software vanishes if no one will use your software. Don't overestimate your work's "importance to the world".


More tips you might take into consideration:

Use a serial which is several KB long of arithmetical transforms, to drive anyone trying to crack it insane. This makes a key generator almost impossible - Also, brute force attacks are blocked very efficiently.

Caution with the Runtime library! Use it fully when writing the beta versions, in the final release rewrite some functions at least to make crackers life harder.

Mangle data. Protection that mangles data is usually a good one.
At least a part of your protection should be embedded inside the data manipulation. Data structures can take ages to understand basing only on disassembly listings, they also are more error-prone for crackers.
Example: Imagine a charting program .. e.g., just disabling printing and later on enabling it basing on some registration# is the most often committed suicide. Let your things print. When creating data structures for printing, mangle them in some way. Unmangle them just before printing, using reg# or something other for that purpose. Even more, make this mangling subtle. Assume that you've got a pie chart to print. Don't alter anything, but add some not too big random numbers to values of data series - this is mangling then. The chart will look "not that bad", but will be otherwise unusable (if the changes are random and on the order of 20%, for example). Finding such protection, if its connection with reg# is not self-evident can take much time. One has to delve inside your data structures and find that dreaded mangling and unmangling code.

Traps. A method I'm not sure about, but I have heard some apps are using it: do a CRC check on your EXE. If it is modified then don't show the typical error message, but wait a day and then notify the user using some cryptic error code. When they contact you with the error code, you know that it is due to the crack. Be aware: such traps could also be activated due to virus infection or incorrect downloads. Imagine the possible aftereffects if you are blaming your potential customer for software piracy.

Don't rely on "EXE-packers". For almost any tool which compresses EXE files (Shrinker, WWPack32, NeoLite, ASPack - to list the most popular ones) there's at least one uncompressor available (for one of them I know about a total of 8, half of them downloadable with source...) so compressors capable for software-protection should at least support configurable encryption. Unpackers for the above (and other) tools are not too wide-spreaded, however, don't rely on them as your program's (one and only) "protection" - typical crackers usually have their hard disks full of such "tools".

Recompile and re-release often! Especially if you are modifying your "anti-cracking" routines often, even more advanced cracks with code-searching capabilities will be useless (see also the related tips in the above section of this FAQ).

Control your own distribution! Putting your apps on compilation CDs or submitting them to "autonomic" software mirrors like SimTel, WinSite or HotFiles has two sides to take into consideration: if a crack is developed for a version that is on 30,000 CDs or downloadable from 50 mirrors worldwide, that version is likely to be pirated, and once a crack for it is available, every user will not have problems to find a download location of the version the crack works on. The other side is that from a sales point, you should make your product as easy as possible to get. You will probably gain more in sales than you will lose in theft (if your software is good and innovative, of course)! Fact is: reducing publicity (i.e., distribution channels) of your software will only guarantee a reduction in sales. My personal suggestion would be to focus on the various other tips on the page, especially to distribute slightly modified versions of your app to the various sites and CDROMs which will at least ensure more work and confusion for potential crackers.

"Destructive" code in your program - yes or no? Sometimes developers tell that they put destructive routines in their programs in case their internal checking routines detect that the app was cracked. They delete system files on the user's system or mess up the Windows Registry, let the program create buggy results (obviously buggy or just noticeable after careful checks) or simply pop up warnings that "a certain patch" leads to "damage to the system files" or "contains a virus". While this might be a good way to "shock" sensible novice crackers, I truly don't believe this is a good (or even effective) method to protect your work. The typical user will think: "Who knows what activates the virus inside this app -- I'll better delete it at once!" and decide for an alternative product. After all, destructive functions or even threatenings like that may result in severe problems with consumer laws of certain countries. At least your product will be suspicious if something "happens" on the user's computer - and which professional developer would want that?


Advanced tips ..given by assembler freaks.

The rcr/rcl trick
If a rcr/rcl is performed on a value, it becomes much more of a pain to crack - you can't reverse it with by negating it's effects without knowing what the value of the carry flag was before the original operation. If the carry flag is created as a result of some other pain in the neck operation, you are probably onto a winner.
Stick conditional jumps in. Everywhere.
Conditional jumps are not fun to reverse engineer. No loops, but jumps which conditionally bypass/include portions of your wonderful key manipulation code. There is no easy inverse operation to be performed here.
Use portions of the code as magic number tables.
(preferably critical sections). You have no idea how annoying this can be, if you're like most crackers and like to change things around using softice (a popular cracking tool).
Play with the cracker's mind.
This one is fun :-) Stick series of nops in, as though you were doing self-modifying code (oh my god! what the heck! nops? Aha! Self-modifying code! Idiot spends next three years trying to find the code that should be there.). Pepper the code with junk instructions. Cut the code up into little pieces and put them all over the executable, with (preferably conditional) jumps between them. - Anything which you would find a pain in the neck.
Detect SoftIce. Early.
Now crash the computer. You can crash a pentium or a pentium with MMX even without a vxd by the opcode: F0 0F C7 C8 (illegal form of cmpxchg8b instruction with lock prefix). Beyond that, we have to resort to the tried and true methods. Using a vxd, take the CPU out of protected mode. Windows doesn't like that. Wonder why? .. On the other hand,
Don't loose too much time on writing anything that will kill disassemblers or debuggers.
Doing it is worthless, believe me, people who made them or others will soon find the way around, so shift your interest to more important stuff. Just do things which are easily and fast to afford, like the above tip.

Special on Delphi Reverse engineering
Quoted from a helpful cracking tutorial*) - just read and learn from it (useful for other RAD tools, too)!

"Let's learn something about the innards of new Borland's programming tools. This knowledge will allow us to speed up cracking sessions, as will teach shareware programmers who use Delphi to be more careful and not to happily expose their 'secrets' to curious eyes B) [..]
VCL stands for "visual component library", a library used by recent Borland visual languages as Delphi and BC++ Builder.
These environments use a proprietary resource format, that appear as 'RCDATA' when listed by Resource Workshop. These resources contain 'forms'. In Delphi jargon, forms are the windows of the program. All the info about their design is stored there. When a typical Delphi app is starting, the initialisation code creates the forms, loading the required information from the resources. Sometimes this loading is deferred - forms that aren't used very often are created and destroyed as needed.
This system is the best and the worst of Delphi. It allows a very fast way of programming but, for full-length apps, it can slow down the loading.
The really interesting part of this information is that the address of the routines - called in response to user interactions with the elements of the form - are bound at run time by name. So knowing these names we can find the appropriate addresses!
If you have cracked any Delphi apps, you have surely experienced the long chain of calls inside the library, from the breakpoints on the API calls to the "do something" code. I hoped that these addresses could help in pinpointing the relevant code."
[..describes his installation of a quite well-known Delphi-writen application..] I cracked it completely and without problems, as you are about to see :=) After first installation the weeks passed and I hadn't had the time to work on it... when I started it, I found a nasty 'Your evaluation period has expired' message :-(
The first step is to gather the information about the target exe with a resource or form spy tool. You may be tempted to investigate TVALIDATORDLG, the form where the user name and registration key is obviously input. But all you'll find is a mere dialog. The real work is accomplished from its caller: TSPLASHFORM. This is the nag window that appears at the beginning of the program, as well as when it's shutting down and from the Help->About menu.
You can select TSplashForm and look at the text representation of it. A lot of information about the buttons and labels will appear. Let's concentrate on the following part, near the end:

  object RegButton: TButton
    Left = 200
    Top = 176
    Width = 97
    Height = 25
    Caption = 'Register'
    TabOrder = 1
    OnClick = RegButtonClick
  end

What's that? This is the button with the caption "Register". You can see its size, position... and something with a suggestive name: "OnClick". "OnClick" tells us the name of the routine invoked when the user presses this button. Once we have the name (yes, "nomen est omen" :) we can search for the address of this routine. This is because the routine is bound to the button at run time by name.
Using a hex editor, I looked for "RegButtonClick" and I found it twice. The second occurrence is the resource itself, the first is within an address table:

000A4990 ____ ____ ____ BC57 4A00 0E52 6567 4275 ______.WJ..RegBu
000A49A0 7474 6F6E 436C 6963 6B__ ____ ____ ____ ttonClick_______

Now look at the magic numbers before the name. There is a byte ('0E') indicating the length of "RegButtonClick" (14 characters) and before that an address: 004ABC57.
Some disassemblers seem to think that file is too long and it doesn't disassemble this portion of the exe correctly - however, with a special tool we can bpx on this and... right! It stops at the point just when we push the button.
A couple of instructions forward you'll find a CALL. Tracing into it you'll find a "standard stack frame" in 44ECC8:

0044ECC8 55     push ebp
0044ECC9 8BEC   mov ebp, esp
...

This is the kind of thing expected at the beginning of a high level routine, made by the application programmer. We have avoided the whole chain of library calls through the VCL from Windows notifications, and landed in the right place!
From this point, there are some calls you can easily test by setting breakpoints on them - you'll find that their purpose is to show the dialog asking for the user name and registration key. Then, the key is calculated from the user name and compared with the one the user entered. You can enter the name you choose, and anything as the key, after BPXing 44ED69. Here, a call to a routine compares two strings. D EDX will show the fake key you entered and D EAX will show the correct calculated key. Easy, isn't it? A ten minute crack by a beginner!!
[description about spying the key generator routine comes next. It's been an average routine of about 10-20 Object pascal code lines.]
How this way of cracking can be avoided?
Read my tips above. The basics are: don't use automatic methods created by double clicking on the button or the object inspector. Write your code somewhere else in your program, preferably in another module, and bind it to the button using code such as:

  RegButton.OnClick := RegButtonClick;

Of course you'll need to enter this code after the form is created and before it's called. Best if it's rounded by a lot of unrelated stuff. This won't necessarily prevent your program from being cracked of course, but things will not be as easy as you have seen in the lines above O:)

Notes on registration numbers
(if you can't avoid them) ]-)

Balance between security, feasibility, programmability and end-user headaches
Too long, non-alphanumeric Reg#'s tend to be continuously entered badly. Think about requiring to enter a verification field (as commonly used with passwords) or, at least, provide a "non-persistent" Reg# entry field so that the user will rewrite the Reg# each time, possibly correctly at last. Many people will just "glance-compare" the entered Reg# and the one (possibly) emailed to them, arriving at the final thought that they did enter it correctly, whereas the font is too small or they are too tired to notice that this '1' and 'l' have been interchanged (in a reg# like 'l83jjd_0)pH1lTe' )
Refrain from any user feedback. The Reg# entry box should accept strings of any length, without any validation. Don't give crackers the knowledge about the type of your Reg# - if you do "online-verification" which shows that it's 10 chars long or that is contains only uppercase chars helps - so don't help them!
Calculate the number of potential users! There's nothing bad like if you have to update 9,999 users because you didn't expect that there might be 10,000 of them and have to shoot out a new version which is capable for these Reg#'s...
If your Reg# is 10 numbers long,.. .. there are 10^10 possible Reg#'s. But since your app might find let's say only 10^4 (10'000) users, you should invent an algorithm that assigns each one of 10^4 users one of 10^10 reg#'s, and does it somewhat uniformly. This prevents people and programs (some .vxd based "macro" players, for example) to be used for brute force approach. If there are only 10^4 users and you allow 10^9 "valid" Reg#s out of 10^10, on average each 10th Reg# tried brute-force will be valid, whereas on the case of 10^4 prospective users, that many valid reg#'s and space of 10^10 Reg#s, on average only each 10^6th Reg# tried brute force will be valid. Ever calculated how much time it would take to brute-force search 10^6 numbers, even using a fast machine and extremenly fast macro player (keystroke generator simulating Reg# entry and checking for results)?
the assignment operator that assigns User# to Reg# shouldn't be trivial, and it's implementation should be done in Assembler by someone experienced both in Maths and Assembler. Remember that Delphi still allows you to directly use ASM code in your source! Then, check your operator. create graphs of how it works. Understand your own work, especially its drawbacks and vulnerabilities
Be inventive. Don't use anything that seems simple, quick and effective unless you've come with something like Einstein's relativity theory, your approach is yes, simple, yes, quick, but no, not effective, and yes, easy to crack. I'm sorry, but we aren't geniuses and developing a good protection scheme takes some time.
Don't have a single registration code. Make the key depend on some user-specific info - have a way to get the user info out of the registration codes. If you find a code on the web, track down the user and harass him. Threaten to do this when you give paying users their codes. [Ch.Losinger]
Dynamically create accelerator keys in your "register" dialog box. These should be for keys used in the registration number entry (0-9,a-z, for example). Each accelerator could call a different routine, if feasible - this makes breakpointing tougher - and store the flag that the given char was entered somewhere else. Also, each keypress could modify some global variable, in a way that is decodeable for you (and just you, if possible ;). Finally, there should be some kind of 'monitoring' routine that acts accordingly, paining the characters on the dialog box and taking actions upon backspace and enter, for example.
Encrypt your good code - never decrypt it. And encrypt the User-Code to test against your good code... [Ch.Losinger]

Adding timebombs to your program
(if you can't avoid them) ]-)
"Timebombs" usually mean runtime limits of any form developers include in their programs to limit the time or number of runs they allow before they quit (all or most) operation - or just opening a registration window anymore. Knowing this FAQ, you will immediately see the weak point of this protection scheme: as long as your application is intended to operate fully during its evaluation period, it must also come with its full code and thus can quite easily be cracked. Beside that, there are dozens of programs on the web which do nothing else than faking the system date so that your app thinks it is still inside the evaluation period.
So, don't just rely on the system date. Get the date of several files, like SYSTEM.DAT, SYSTEM,DA0 and BOOTLOG.TXT and compare them to the system date. Require that the time be greater than the last run.
The best, however, is to simply say "Goodbye" to startup/time-limits! There is simply no way to protect a time-limited demo. You won't believe it - there even exist patched versions of Windows DLL's (!) which will make your demo think it has never run before on this computer. At one point or another, you will have to save your date or program start information on the computer: in a file, in the registry, somewhere - and Windows provides GREAT ways to spy on any changes made to these devices. "This is a war that can never be won." (D.Filion)

How can I find out if cracks exist for my program?

Use the Search engines
Using search engines is one of the best methods. Most software pirates have overboarding self-confidence and even submit their illegal pages to popular search engines on the web. If you search Altavista, Lycos or especially Meta-searchers like MetaCrawler and your software is already present for more than a few months, you'll maybe have "luck" and find some "Warez Pages" which offer cracks or Registration codes for your program.

Search pages using Free Webspace
Software pirates, students which think it's cool to offer "Warez" and "Crackz" and other strange kinda persons especially love the free services offered by sites like GeoCities, Xoom, Tripod and others to offer their stuff. Most of them offer at least 5 MB free webspace, which is enough to provide thousands of cracks. Beside that, those sites are busy like BIG railway stations and like there, criminals feel quite safe to go after their "hobbies" there. Good for us, almost all free webspace providers also offer search features which allow you to search just all pages of their members, which is much more accurate and easier than using the big engines of which some are not kept up-to-date very good. Just connect to their main portal and start your search. If cracks exist for your program, you have very good chances to find them on some of these member pages.
In such a case, you should contact the maintainers of the service (almost all even provide special email addresses for piracy reports (such as abuse@geocities.com).

Search newsgroups
Unlike what polititians are trying to suggest to the public, it's in most cases quite easy to track down who is posting cracks, serial numbers or even full licensed copies of your software in newsgroups like alt.cracks.* and others. Just let your newsreader display all header fields and check carefully where those people are writing from. Since almost any news server requires complete authentication before posting, you have good chances to find out who "hides" hinter strange names like "Hackman" or "Piratez2000". If you have no success, simply contact the webmaster of the server where the message comes from or forward him the posting, requesting action against this person.

Make use of "Crack Search Engines"!
The easiness of CGI and increasing success to powerful webservers leaded to some quite powerful Crack Search Engines during the recent years. They can be of enourmous help for finding cracks for your software and then starting action against the responsible persons providing these pages and cracks. Sorry, I won't provide links for those sites here, but you can't miss them during your "investigations" in those slippy parts of the web.

Use Web-Robots
Sites like http://www.netmind.com offer robots that notify you by email when a page changes. Since you can also define result pages of, for example, AltaVista searches for a crack or key to your program, this is a cool way to get "paged" as soon as some spider hits a website of a child which "-cool, man!-" offers a crack page. You can even do that for newsgroup searches!

Subscribe to mailing lists
If you don't know how to go on, ask in the Anti-Warez Mailing-list or other, Shareware-related mailing lists (see my "Delphi Tips" pages for more links).
Their members watch the activities of most popular cracking groups and have been quite active closing many of them down during the times. They will surely help you if you yourself don't have success. Shareware developers should join forces - it pays!

What to do if you found a crack for your app
"Blow the whistle!"..

I've heard and read many programmers telling "you can't do everything against them, there are too many crackers around, too many warez sites on the Net, so that few people ever get caught."
Fact is, however, that you as a software author would have excellent chances to win any lawsuit against operators of ISP's awaringly keeping crack/warez sites online or against the crackers themselves. Hundreds of sites have been closed down during the last years due to offering or linking to pirated software. In some cases, computers were confiscated, and the operators are still paying settlements.
So, you don't have just to accept if you find pirated copies or cracks for your software around .. try to detect where it comes from and get into action against the source!
Forget about the BSA (http://www.nopiracy.com, http://www.bsa.org) - these are just commercial organizations which just take "orders" for their paying clients. No, they don't work for everybody - usually they only come in to action when the target is a large firm, using software from one of their biggest clients (no prizes for guessing which one). Can you say "M$ Militia" ?
Do internic queries on the crackers site (www.checkdomain.com or use one of the WhoIs tools linked at the bottom of this page), contact the sysadmin, explain the situation. If the ISP is a fair and serious one, there are chances that the crackers will receive a serious warning to remove all the illegal stuff from their sites or that it will even be closed without delay.
If the crack was published on on "free" pages like Xoom, Geocities or Tripod, or if the cracker used a redirection service, send a complainment mail to the abuse complainment address of the service - just a matter of a few minutes, but very effective.
I've listed the most important addresses in the next section.
If this doesn't help (seldom seen, but possible), contact the local authorities of the state where the ISP is located. Most countries even provide email addresses for reporting crime activities (like childporn, but they are also open for pirated software), or at least their police administration can be reached by email. There are good chances that the ISP will be threatened to lose his licence.
Finally: get yourself a good glass of wine and enjoy it. You have written a good program! (otherwise no one would lose time trying to crack it)
Where to report cracking pages found thru' free services

..if you found a crack on a page hosted by Freespace Providers:
//members.xoom.com/??? -> send mail here.
Geocities.com/??? -> fill out this form.
???/Freeservers.com/??? -> send mail here.
FreeAlways.com/??? -> send mail here.
Webjump.com/??? -> send mail here or fillout this online form.
WebAzn.com/??? -> send mail here.
Tripod.com/??? -> send mail here.
Yahoo.com site or link: mail here and receive detailled instructions.
AcmeCity.com site or link: mail here.
PolBox.com site or link: mail here.
FortuneCity.com site or link: mail here.
..if you found a crack on a page forwarded by a redirection service:
http://???.to/??? -> fill out this form or send mail here or here or here. Just to be sure you should verify the correct address since there are various redirection services holding .TO domains.
http://???.tsx.org/ -> send mail here.
http://???.findhere.com/ -> send mail here.
http://???.cjb.net/ -> send mail here.
http://???.da.ru -> send mail here.
http://???.mainpage.net -> send mail here.
http://???.Web-Page.net -> send mail here.
http://???.MainPage.net -> send mail here.
http://???.GamesPage.com -> send mail here.
http://???.Main-Page.net -> send mail here.
http://???.MusicPage.com -> send mail here.
http://???.SexyPage.net -> send mail here.
http://???.Biz-Page.com -> send mail here.
http://???.Co-Inc.net -> send mail here.
http://???.Co-Ltd.net -> send mail here.
http://???.Pty-Ltd.net -> send mail here.
http://???.Pte-Ltd.net -> send mail here.
http://???.Int-Ltd.net -> send mail here.
http://???.Intl-Ltd.net -> send mail here.
http://???.TourGuide.net -> send mail here.
http://???.Net-Shop.net -> send mail here.
http://???.Subdomain.de -> send mail here.
Tip:
Also try to find out the REAL URL of the site the cracker wants to hide behind the redirection URL (even if it just displays the redirection URL like "http://come.to/supercracks" permanently - you can easily find out the "real" URL of the cracking site by viewing the Source code of the displayed page with Netscape Navigator: the URL and/or domain address displays in the title bar of the Source window..) and also ask the webmaster or uplink provider of this site for assistance - that way you have good chances to help closing at least one, if not both of them.
..if you found mailing list or newsgroup messages offering or linking to cracks posted from:
???@my-deja.com -> send mail here.
???@email.com -> send mail here.
???@mail.com -> send mail here.
???@gironet.nl -> send mail here.
???@chello.nl -> send mail here (Webmaster might need threatening with authorities).
???@hotmail.com -> send mail here
Where to report cracking pages found at asean sites

..russian pages:
the FSB are part of the (former?) KGB and are told to have the power to shut down and hunt "illegal" sites ("illegal" has a special meaning here, it's suggested that - in case you are - you don't tell you're from the States. ;) Mail can be sent here.

Facts and Myths about Software pirating
Provided by the Business Software Alliance

Myth: "None of the software offered was stored on my site - I only had links to the files."
Fact: You could be liable for anything that you do that contributes to the infringement of copyrighted works. This includes facilitating a download by linking to remote files.
Myth: "I have a disclaimer on my site that protects me."
Fact: A disclaimer cannot shift your liability to someone else. You are still contributing to copyright infringement.
Myth: "I thought it was okay to download programs to try them out if I delete them within 24 hours."
Fact: This is a common Net Myth. You may only use the software as described in the end-user license provided by the software publisher.
Myth: "..there is something called 'freedom of speech' in this country..?"
Fact: Free speech refers to your right to provide opinions and original content without censure. Even so, free speech has limits. You cannot use this right to break the law. Internet sites that provide access to others' copyrighted materials - whether it's on the same site or a remote site - violate the author's right to control distribution of their works, which is against the law.
Myth: "What about "fair use"? I am only providing a service for "educational purposes."
Fact: Fair use is widely accepted to mean the reproduction of a part of a copyrighted work, not the wholesale copying of an entire program or contributing to software piracy.
Myth: "I only post serial numbers."
Fact: Legal software comes with required numbers or keys to install the software. It should not be necessary to get these off the Internet. Providing them for others to use with pirated software contributes to copyright infringement and is illegal."
Myth: What if I lose my serial number or one of my disks is trashed?
Fact: Most software publishers have provisions for replacing media. Contact them to resolve your problems.
Myth: Writing a book about robbing banks and robbing them yourself are two different things, not?
Fact: A better analogy is "robbing the bank" vs. "driving the getaway car." Or, another analogy is stealing software vs. marking the computer store window with an big X and telling people that, if they throw a brick at the X, they can steal the software in the store window. Both are illegal.
Myth: Software is so expensive, and I've wasted a lot of money just to find out that an expensive program is worthless! If it's any good, then I'll reward the authors. If not, forget the compensation!
Fact: Cars are expensive, too, but society doesn't allow people to use them and decide later if they want to pay for them or not. In the same way, you cannot use pirated software and pay for it only if you want to at some later date.
Myth: Isn't everything on the Internet in the public domain?
Fact: An author does not waive copyrights by publishing on the Internet. Pirated software is published on the Internet by someone other than the author or without the author's explicit permission.
Myth: It's not really illegal to distribute warez.
Fact: An author can seek civil damages in the amount of their actual value, or statutory damages of $100,000 per work infringed. (Note that some "programs" are actually bundles of more than one copyrighted work.) Criminal penalties include fines of up to $250,000 and jail terms up to 5 years, or both. In December 1997, President Clinton signed a law called the "No Electronic Theft" (NET) Act that allows for criminal prosecution of copyright infringement, even where there is no profit motive, closing a loophole in U.S. copyright law.

Set the position of a help window

Problem/Question/Abstract:

If you open a help file from your application, the help window always initializes at the same position. How do you change that, for instance to position a help window side by side with your form?

Answer:

You can use the Winhelp macro PositionWindow.

procedure TForm1.Button1Click(Sender: TObject);
var
  command: array[0..255] of Char;
begin
  command := 'PW(0, 0, 512, 512, 1, "main")';
  application.helpcommand(HELP_COMMAND, Longint(@command));
end;

What it does:

The code example above uses the HELP_COMMAND constant to execute a macro. The macro we use here is "PositionWindow" or - short - "PW". It defines the upper left corner (x1, y1) as (0,0) and the lower right corner (x2, y2) as (512,512).
The following parameter is the integer constant for "SW_SHOWNORMAL". Winhelp does not recognize the string "sw_shownormal" in the macro string. The last parameter is the name of the window.

One word about the coordinates:

The position and size of a help window always relates to a virtual screen size of 1024 x 1024 pixel, regardless of the screen resolution. If you set the size to (0, 0, 1024, 512), the help window would cover exactly the upper half of the screen.

How to paint a moving progress bar using a background thread

Problem/Question/Abstract:

I query several tables and display records in a TDBGrid . However, due to the size of the tables and joins, it takes a while for the query to execute. Is there any way to show a progress bar with a timer that increments the position but continues to work while the query is being executed.

Answer:

A progress bar would not be an ideal choice since you cannot determine up front how long the query will take, so you do not know the range the progress bar has to cover. A simple kind of animation that tells the user basically only that the application is not hung would be more appropriate. One could do such a thing in a secondary thread but it would have to be done using the plain Windows API and no Synchronize calls (since the main thread is blocked in the BDE call). Here is an example:


unit anithread;

interface

uses
  Classes, Windows, Controls, Graphics;

type
  TAnimationThread = class(TThread)
  private
    { Private declarations }
    FWnd: HWND;
    FPaintRect: TRect;
    FbkColor, FfgColor: TColor;
    FInterval: Integer;
  protected
    procedure Execute; override;
  public
    constructor create(
      paintsurface: TWinControl; {Control to paint on}
      paintrect: TRect; {area for animation bar}
      bkColor, barcolor: TColor; {colors to use}
      interval: Integer {wait in msecs between paints}
      );
  end;

implementation

constructor TAnimationThread.create(paintsurface: TWinControl;
  paintrect: TRect; bkColor, barcolor: TColor; interval: Integer);
begin
  inherited Create(true);
  FWnd := paintsurface.Handle;
  FPaintRect := paintrect;
  FbkColor := bkColor;
  FfgColor := barColor;
  FInterval := interval;
  FreeOnterminate := True;
  Resume;
end;

procedure TAnimationThread.Execute;
var
  image: TBitmap;
  DC: HDC;
  left, right: Integer;
  increment: Integer;
  imagerect: TRect;
  state: (incRight, incLeft, decLeft, decRight);
begin
  Image := TBitmap.Create;
  try
    with Image do
    begin
      Width := FPaintRect.Right - FPaintRect.Left;
      Height := FPaintRect.Bottom - FPaintRect.Top;
      imagerect := Rect(0, 0, Width, Height);
    end;
    left := 0;
    right := 0;
    increment := imagerect.right div 50;
    state := Low(State);
    while not Terminated do
    begin
      with Image.Canvas do
      begin
        Brush.Color := FbkColor;
        FillRect(imagerect);
        case state of
          incRight:
            begin
              Inc(right, increment);
              if right > imagerect.right then
              begin
                right := imagerect.right;
                Inc(state);
              end;
            end;
          incLeft:
            begin
              Inc(left, increment);
              if left >= right then
              begin
                left := right;
                Inc(state);
              end;
            end;
          decLeft:
            begin
              Dec(left, increment);
              if left <= 0 then
              begin
                left := 0;
                Inc(state);
              end;
            end;
          decRight:
            begin
              Dec(right, increment);
              if right <= 0 then
              begin
                right := 0;
                state := incRight;
              end;
            end;
        end;
        Brush.Color := FfgColor;
        FillRect(Rect(left, imagerect.top, right, imagerect.bottom));
      end;
      DC := GetDC(FWnd);
      if DC <> 0 then
      try
        BitBlt(DC, FPaintRect.Left, FPaintRect.Top, imagerect.right, imagerect.bottom,
          Image.Canvas.handle, 0, 0, SRCCOPY);
      finally
        ReleaseDC(FWnd, DC);
      end;
      Sleep(FInterval);
    end;
  finally
    Image.Free;
  end;
  InvalidateRect(FWnd, nil, true);
end;

end.


Usage:

Place a TPanel on a form, size it as appropriate. Create an instance of the TanimationThread call like this:


procedure TForm1.Button1Click(Sender: TObject);
var
  ani: TAnimationThread;
  r: TRect;
begin
  r := panel1.clientrect;
  InflateRect(r, -panel1.bevelwidth, -panel1.bevelwidth);
  ani := TanimationThread.Create(panel1, r, panel1.color, clBlue, 25);
  Button1.Enabled := false;
  Application.ProcessMessages;
  Sleep(30000); {replace with query.Open or such}
  Button1.Enabled := true;
  ani.Terminate;
  ShowMessage('Done');
end;

How to set the date stamp of a file equal to the date stamp of another

Problem/Question/Abstract:

How to set the date stamp of a file equal to the date stamp of another

Answer:

Just use the following function, which takes two strings representing full DOS path/ file names. The file who's date you wish to set is the second parameter, and the date you wish to set it to is given by the file in the first parameter.

procedure CopyFileDate(const Source, Dest: string);
var
  SourceHand, DestHand: word;
begin
  SourceHand := FileOpen(Source, fmOutput); { open source file }
  DestHand := FileOpen(Dest, fmInput); { open dest file }
  FileSetDate(DestHand, FileGetDate(SourceHand)); { get / set date }
  FileClose(SourceHand); { close source file }
  FileClose(DestHand); { close dest file }
end;

Get the Windows Start Menu folder location and name

Problem/Question/Abstract:

How to get the Start Menu folder location in Windows regardless of the OS (WinNT Wks, WinNT Srv, Win95, Win98)?

Answer:

Solve 1:

procedure FreePidl(pidl: PItemIDList);
var
  allocator: IMalloc;
begin
  if Succeeded(SHGetMalloc(allocator)) then
  begin
    allocator.Free(pidl);
{$IFDEF VER90}
    allocator.Release;
{$ENDIF}
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  pidl: PItemIDList;
  buf: array[0..MAX_PATH] of Char;
begin
  if Succeeded(ShGetSpecialFolderLocation(Handle, CSIDL_STARTMENU, pidl)) then
  begin
    if ShGetPathfromIDList(pidl, buf) then
      ShowMessage(buf);
    FreePIDL(pidl);
  end;
end;

Needs ShlObj in the Uses clause.


Solve 2:

To obtain the name of the Windows\Start Menu\Program directory on a system, use code like this:

function GetSpecialDir(Index: Integer): string;
var
  S: string;
  IDL: PItemIDList;
begin
  Result := '';
  if Succeeded(SHGetSpecialFolderLocation(0, Index, IDL)) then
  begin
    SetLength(S, MAX_PATH);
    if Succeeded(SHGetPathFromIDList(IDL, PChar(S))) then
      Result := PChar(S);
  end;
end;

You call it with code like:

ProgDir := GetSpecialDir(CSIDL_PROGRAMS);

The CSIDL_ identifiers are specified in ShlObj.pas, so are the SHGetSpecialFolderLocation and SHGetPathFromIDList functions.


Solve 3:

Here is an example to get the startup folder:

{ ... }
var
  idRoot: PItemIDList;
  Buf: array[1..MAX_PATH] of Char;
begin
  StartupFolder := '';
  try
    if SHGetSpecialFolderLocation(Handle, CSIDL_STARTUP, idRoot) = NOERROR then
    begin
      FillChar(Buf, SizeOf(Buf), #32);
      SHGetPathFromIDList(idRoot, PChar(@Buf));
      SetString(StartupFolder, PChar(@Buf), Length(Buf));
      StartupFolder := Trim(StartupFolder) + '\';
    end;
  except
  end;
end;
{ ... }

Preventing a user from closing a window except at shutdown or restart

Problem/Question/Abstract:

How to oreventing a user from closing a window except at shutdown or restart

Answer:

We all know how to prevent a window from closing: Simply write event code for the OnCloseQuery event and set CanClose to False. Once that's done, no matter what a user presses, the window won't close. Here's some code:

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := False;
end;

But what if you wanted to be able to close a window only when you reboot the machine? With the scenario above, that would be impossible. Fortunately though, there is a solution, and it resides in the windows message WM_QUERYENDSESSION.

WM_QUERYENDSESSION is generated by Windows when the OS is resetting: Either at a shutdown or a restart. Using this message, we can set a boolean flag variable and interrogate its value in OnCloseQuery to allow us to close the window and reset the operating system. Look at the unit code below:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    procedure WMQueryEndSession(var Message: TWMQueryEndSession);
      message WM_QUERYENDSESSION;
  public
    WindowsClosing: Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  WindowsClosing := False;
end;

procedure TForm1.WMQueryEndSession(var Message: TWMQUERYENDSESSION);
begin
  WindowsClosing := True;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := WindowsClosing;
end;

end.

As you can see, I've created a public variable called WindowsClosing. When WM_QUERYENDSESSION fires, it sets the variable to True. Then in OnCloseQuery, CanClose is set to the value of WindowsClosing. Notice that I set WindowsClosing to False in OnCreate. This is purely for initialization purposes to make sure that previous attempts to close the window are foiled.

How to implement a Query by Form service for a TDBGrid

Problem/Question/Abstract:

How to implement a Query by Form service for a TDBGrid

Answer:

Here is a Delphi unit for a modal dialog to support Query By Form (QBF) for DbGrid components which receive data from Table components (not Query components). The lack of this as a built-in feature makes it harder for Delphi to compete with more resource-intensive tools like Oracle Forms. This unit is not as powerful as the built-in QBF features of Oracle Forms, but it does fill a significant gap in functionality.

unit Db_QBF;

{This unit provides a basic but effective Query By Form service for database access applications written using Borland Delphi. This unit also provides a similar Sort By Form service.

The Query By Form service displays a modal dialog box with a StringGrid of searchable fields, taken from the calling DbGrid. The user may enter an exact search value for any number of fields, and may use drag and drop to rearrange the sort order of the fields. (Only the fields that contain search values are relevant to the sort.) When the user clicks the dialog's OK button, this unit modifies the calling DbGrid's IndexFieldNames property, applies a search range (of exact values), and refreshes the data. If the user leaves all search values empty, this unit clears the calling DbGrid's IndexFieldNames property, clears the search range, and refreshes the data.

The Sort By Form service works in a similar manner, except that it does not accept search values from the user. The user drags and drops the field sort order, then clicks the OK button. This unit modifies the calling DbGrid's IndexFieldNames property, clears the search range, and refreshes the data.

Create the corresponding dialog form using the New Form action, selecting a Standard Dialog Box. Place a StringGrid on the form (as found in the Additional tab of the component toolbar. Set the StringGrid's Height to 161 and its Width to 305. Finally, replace the new form's .PAS source with this unit.}

interface

uses
  WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  StdCtrls, ExtCtrls, Grids, DBGrids;

{The following two procedures provide the mechanism for accessing the services of this unit. Have a button or menu item on the calling form call one of these procedures, passing the DbGrid as the argument. (Remember to add "uses Db_QBF;" to the calling form's implementation section.). Restriction: The DbGrid must reference a DataSource that, in turn, references a DataSet that is a Table. This unit does not support a DataSet that is a Query, since it has no IndexFieldNames property.}

procedure QueryByForm(grid: TDbGrid);
procedure SortByForm(grid: TDbGrid);

type
  TdlgQBF = class(TForm)
    OKBtn: TBitBtn;
    CancelBtn: TBitBtn;
    HelpBtn: TBitBtn;
    gridQBF: TStringGrid;
    procedure OKBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  dlgQBF: TdlgQBF;

implementation

uses
  Dialogs, Db, DbTables;

{$R *.DFM}

const
  qbfRowHeight = 16;
  qbfColWidth = 150;
  qbfFieldLabel = ' Field ';
  qbfValueLabel = ' Value ';
  qbfQueryCaption = ' Query for Table ';
  qbfSortCaption = ' Sort Order for Table ';
var
  {Remember some things for use by the QBF dialog's OK button}
  CallingGrid: TDbGrid;
  CallingMode: (modeQuery, modeSort);

procedure SetupAndShowForm;
{ Called by the two exported procedures }
var
  i, j, n: integer;
  tbl: TTable;
  f: TField;
begin
  n := CallingGrid.FieldCount;
  if n <= 0 then
  begin
    { Exceptions may be raised instead of showing messages }
    MessageDlg('Db_QBF unit called for a DbGrid without any Fields', mtWarning,
      [mbOK], 0);
  end
  else if CallingGrid.DataSource = nil then
  begin
    MessageDlg('Db_QBF unit called for a DbGrid without a DataSource', mtWarning,
      [mbOK], 0);
  end
  else if CallingGrid.DataSource.DataSet = nil then
  begin
    MessageDlg('Db_QBF unit called for a DbGrid with a DataSource without a DataSet',
      mtWarning, [mbOK], 0);
  end
  else if not (CallingGrid.DataSource.DataSet is TTable) then
  begin
    MessageDlg('Db_QBF unit called for a DbGrid with a DataSource that
                        is not a Table', mtWarning, [mbOK], 0);
  end
  else
    with dlgQBF.gridQBF do
    begin
      {These properties can also be set once at design time}
      DefaultRowHeight := qbfRowHeight;
      Scrollbars := ssVertical;
      ColCount := 2;
      {Even the Sort service needs a dummy second column}
      {These properties must be set at run time}
      RowCount := Succ(n);
      Cells[0, 0] := qbfFieldLabel;
      Options := Options + [goRowMoving];
      tbl := TTable(CallingGrid.DataSource.DataSet);
      if CallingMode = modeQuery then
      begin
        dlgQBF.Caption := qbfQueryCaption + tbl.TableName;
        Cells[1, 0] := qbfValueLabel;
        Options := Options + [goEditing]; { Allow user to enter values }
        DefaultColWidth := qbfColWidth;
      end
      else
      begin
        dlgQBF.Caption := qbfSortCaption + tbl.TableName;
        Cells[1, 0] := ''; {Dummy "value" column to allow fixed "field" column}
        Options := Options - [goEditing]; {User just reorders the rows}
        DefaultColWidth := (2 * qbfColWidth); {Shove aside dummy 2nd column}
      end;
      j := 0; {Actual number of fields shown to user}
      for i := 1 to n do
      begin
        f := CallingGrid.Fields[Pred(i)];
        if f.DataType in [ftBlob, ftBytes, ftGraphic, ftMemo, ftUnknown, ftVarBytes]
          then
          RowCount := Pred(RowCount) {Ignore unsearchable fields}
        else
        begin
          Inc(j);
          Cells[0, j] := f.FieldName;
          Cells[1, j] := ''; {Empty search value}
        end;
      end;
      dlgQBF.HelpBtn.Visible := False; {We haven't implemented Help}
      dlgQBF.ShowModal;
    end;
end;

procedure QueryByForm(Grid: TDbGrid);
begin
  CallingGrid := Grid; {Save for use by OK button}
  CallingMode := modeQuery;
  SetupAndShowForm;
end;

procedure SortByForm(Grid: TDbGrid);
begin
  CallingGrid := Grid; {Save for use by OK button}
  CallingMode := modeSort;
  SetupAndShowForm;
end;

procedure TdlgQBF.CancelBtnClick(Sender: TObject);
begin
  {Just dismiss the dialog, without making changes to the calling grid}
  dlgQBF.Hide;
end;

procedure TdlgQBF.OKBtnClick(Sender: TObject);
var
  flds, sep, val: string;
  i, n, nfld: integer;
begin
  flds := ''; { List of fields separated by ';'}
  sep := ''; { Becomes ';' after the 1st field is appended }
  nfld := 0; { Number of fields in the list }
  with dlgQBF.gridQBF do
  begin
    n := Pred(RowCount);
    if n > 0 then
      for i := 1 to n do
      begin
        val := Cells[1, i]; { The user-entered search value (if any) }
        if (CallingMode = modeSort) or (val < > '') then
        begin
          flds := flds + sep + Cells[0, i];
          sep := ';';
          nfld := Succ(nfld);
        end;
      end;
    with CallingGrid.DataSource.DataSet as TTable do
    begin
      IndexFieldNames := flds;
      if (CallingMode = modeSort) or (flds = '') then
      begin
        CancelRange;
      end
      else
      begin
        SetRangeStart;
        for i := 1 to n do
        begin
          val := Cells[1, i];
          if val <> '' then
          begin
            FieldByName(Cells[0, i]).AsString := val;
          end;
        end;
        SetRangeEnd; {Set range end to match range start}
        for i := 1 to n do
        begin
          val := Cells[1, i];
          if val <> '' then
          begin
            FieldByName(Cells[0, i]).AsString := val;
          end;
        end;
        ApplyRange;
      end;
      Refresh;
    end;
  end;
  dlgQBF.Hide;
end;

end.