Using MS Word as a Spelling and Grammar Checker for Delphi

The COM interface exposed by MS Word gives a number of mechanisms for the use of the spelling engine.

• The Word.Application object can call the engine for a single word or string. The return value is a Boolean indicating True (no errors) or False (errors). Further work must be done to provide spelling suggestions / correction.
• The Document object contained by the Word.Application object exposes all the functionality of MS Word, in particular, the MS Word dialog boxes for spelling and grammar checking can be used.

The technique used in this component is the second method. Text is copied to the (hidden) word document, then the appropriate function (spelling or grammar) is called. To discover if the user made any changes to the text, MS Word's ability to track changes is utilised.

RTF text can be checked easily by using the CheckClipBoardSpell / Grammar functions.

Custom Dictionaries: Using custom dictionaries is a powerful feature of Word's spelling checker but there appears to be an error in the documentation (at least I can't get it to work as written in Delphi or VBA within Word itself!). Custom dictionaries are text files (usually with a '.dic' extension) with a sorted list of words - one word on each line. Included the ability to "install" a custom dictionary(s) which will be used in all spell checks. The down side is that the dictionary will now be seen by Word all the time, so it's probably a good idea to remove any such dictionary before exiting your program.

Checking if the user wants to cancel spell/grammar checking: In your own program you could check for the press of a "cancel" button or key. This isn't available when using Word's built in dialogs, so I tend to use the SpellingChecked and GrammarChecked properties to check if there are still errors in the text after a spell check has been completed. If the user has decided to quit, these properties should be False. I have mapped them into the UserCancel property for ease of programming.

Installation is very simple, just copy the code and save it as uSpellCheck.pas and include any of your existing/new dpk file.

How to use:
i) Drop the TActionList component onto a form.
ii) Select StandardAction from TActionList
iii)You will see new TSpellCheck action item under Edit category. select it ;-)
By default this action item is associated with F7 shortcut.
iv) Drop few Editable controls like TEdit, TMemo, TRichEdit etc and run the application and press F7 to trigger Spell Check.

That's it really!

{
Unit Name   : uSpellCheck.pas
Description : TSpellCheck is derived from TEditAction, which is available on
              TActionList. This newly created action acts as a standard EditAction
              for example: It gets enabled when the control is in Editable mode.
Enhancements: Couldn't think of any more as of now...
Create Date : 1st December 2010
Author      : Kiran Kumar Kurapaty
Code enhanced from original author: Andrew Baylis (ajbaylis@melbpc.org.au), Thanks Andrew.
}

unit uSpellCheck;

interface

uses Windows, SysUtils, Classes, ActnList, Forms, StdCtrls, Dialogs, StdActns, ActnRes, Messages, ComObj,
     ActiveX, Variants;

type
  TWordTimer = class(TThread)
  private
    FCaption: string;
    FDelay: Integer;
    FDialogWndClass: string;
    FPopUpExists: Boolean;
    procedure SetDelay(Value: Integer);
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
    procedure Resume;
    property Caption: string read FCaption write FCaption;
    property Delay: Integer read FDelay write SetDelay;
    property DialogWndClass: string read FDialogWndClass write FDialogWndClass;
  end;

  TSpellLanguage = Integer;

  TSpellCheck = class(TEditAction)
  private
    FCancel: Boolean;
    FChangedText: string;
    FConnected: Boolean;
    FHandle: HWND;
    FNumChanges: Integer;
    FOleOn: Boolean;
    FSpellCaption: string;
    FTimer: TWordTimer;
    FUseSpellCaption: Boolean;
    FWordApp, FRange, FWordDoc, FCustDics: OLEVariant;
    FWordDialogClass: string;
    FWordVersion: string;
    FLanguage: TSpellLanguage;
    function GetCheckGWS: Boolean;
    function GetGrammarErrors: Integer;
    function GetSpellChecked: Boolean;
    function GetSpellErrors: Integer;
    function GetUserCancel: Boolean;
    function GetVersion: string;
    function GetWordVersion: string;
    procedure SetCheckGWS(const Value: Boolean);
    procedure SetLanguage(Value: TSpellLanguage);
  protected
    function Internal_checkGrammar: Boolean;
    function Internal_checkSpelling: Boolean;
    procedure StartTimer;
    procedure StopTimer;
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;

    function AddCustomDic(const FileName: string): Integer;
    function CheckClipboardGrammar: Boolean;
    function CheckClipboardSpell: Boolean;
    function CheckGrammar(const Text: string): Boolean;
    function CheckSpelling(const Text: string): Boolean;
    procedure ClearText;
    procedure Connect;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Disconnect;
    procedure RemoveCustomDic(const Name: string); overload;
    procedure RemoveCustomDic(const Index: Integer); overload;
    procedure ResetIgnoreAll;
    procedure SpellingOptions;

    property ChangedText: string read FChangedText;
    property CheckGrammarWithSpelling: Boolean read GetCheckGWS write SetCheckGWS;
    property Connected: Boolean read FConnected;
    property GrammarErrorCount: Integer read GetGrammarErrors;
    property NumChanges: Integer read FNumChanges;
    property SpellChecked: Boolean read GetSpellChecked;
    property SpellErrorCount: Integer read GetSpellErrors;
    property UserCancelled: Boolean read GetUserCancel write FCancel;
    property WordVersion: string read GetWordVersion;
  published
    property SpellCaption: string read FSpellCaption write FSpellCaption;
    property UseSpellCaption: Boolean read FUseSpellCaption write FUseSpellCaption;
    property Version: string read GetVersion;
    property Language: TSpellLanguage read FLanguage write SetLanguage;
  end;

  LangRecord = record
    LocalName: string;
    ID: Integer;
  end;

const // Spelling Language
   SpellLanguage: array[0..63] of LangRecord =
      ((LocalName: 'LanguageNone'; ID: $00000000),
      (LocalName: 'NoProofing '; ID: $00000400),
      (LocalName: 'Danish '; ID: $00000406),
      (LocalName: 'German '; ID: $00000407),
      (LocalName: 'SwissGerman '; ID: $00000807),
      (LocalName: 'EnglishAUS '; ID: $00000C09),
      (LocalName: 'EnglishUK '; ID: $00000809),
      (LocalName: 'EnglishUS '; ID: $00000409),
      (LocalName: 'EnglishCanadian '; ID: $00001009),
      (LocalName: 'EnglishNewZealand '; ID: $00001409),
      (LocalName: 'EnglishSouthAfrica '; ID: $00001C09),
      (LocalName: 'Spanish '; ID: $0000040A),
      (LocalName: 'French '; ID: $0000040C),
      (LocalName: 'FrenchCanadian '; ID: $00000C0C),
      (LocalName: 'Italian '; ID: $00000410),
      (LocalName: 'Dutch '; ID: $00000413),
      (LocalName: 'NorwegianBokmol '; ID: $00000414),
      (LocalName: 'NorwegianNynorsk '; ID: $00000814),
      (LocalName: 'BrazilianPortuguese '; ID: $00000416),
      (LocalName: 'Portuguese '; ID: $00000816),
      (LocalName: 'Finnish '; ID: $0000040B),
      (LocalName: 'Swedish '; ID: $0000041D),
      (LocalName: 'Catalan '; ID: $00000403),
      (LocalName: 'Greek '; ID: $00000408),
      (LocalName: 'Turkish '; ID: $0000041F),
      (LocalName: 'Russian '; ID: $00000419),
      (LocalName: 'Czech '; ID: $00000405),
      (LocalName: 'Hungarian '; ID: $0000040E),
      (LocalName: 'Polish '; ID: $00000415),
      (LocalName: 'Slovenian '; ID: $00000424),
      (LocalName: 'Basque '; ID: $0000042D),
      (LocalName: 'Malaysian '; ID: $0000043E),
      (LocalName: 'Japanese '; ID: $00000411),
      (LocalName: 'Korean '; ID: $00000412),
      (LocalName: 'SimplifiedChinese '; ID: $00000804),
      (LocalName: 'TraditionalChinese '; ID: $00000404),
      (LocalName: 'SwissFrench '; ID: $0000100C),
      (LocalName: 'Sesotho '; ID: $00000430),
      (LocalName: 'Tsonga '; ID: $00000431),
      (LocalName: 'Tswana '; ID: $00000432),
      (LocalName: 'Venda '; ID: $00000433),
      (LocalName: 'Xhosa '; ID: $00000434),
      (LocalName: 'Zulu '; ID: $00000435),
      (LocalName: 'Afrikaans '; ID: $00000436),
      (LocalName: 'Arabic '; ID: $00000401),
      (LocalName: 'Hebrew '; ID: $0000040D),
      (LocalName: 'Slovak '; ID: $0000041B),
      (LocalName: 'Farsi '; ID: $00000429),
      (LocalName: 'Romanian '; ID: $00000418),
      (LocalName: 'Croatian '; ID: $0000041A),
      (LocalName: 'Ukrainian '; ID: $00000422),
      (LocalName: 'Byelorussian '; ID: $00000423),
      (LocalName: 'Estonian '; ID: $00000425),
      (LocalName: 'Latvian '; ID: $00000426),
      (LocalName: 'Macedonian '; ID: $0000042F),
      (LocalName: 'SerbianLatin '; ID: $0000081A),
      (LocalName: 'SerbianCyrillic '; ID: $00000C1A),
      (LocalName: 'Icelandic '; ID: $0000040F),
      (LocalName: 'BelgianFrench '; ID: $0000080C),
      (LocalName: 'BelgianDutch '; ID: $00000813),
      (LocalName: 'Bulgarian '; ID: $00000402),
      (LocalName: 'MexicanSpanish '; ID: $0000080A),
      (LocalName: 'SpanishModernSort '; ID: $00000C0A),
      (LocalName: 'SwissItalian '; ID: $00000810));


  procedure Register;

implementation

uses Registry;

{ TSpellCheck }
procedure TSpellCheck.ExecuteTarget(Target: TObject);
begin
  if Assigned(GetControl(Target)) then
  begin
    try
      if CheckSpelling(GetControl(Target).Text) then
        GetControl(Target).Text := ChangedText;
    except
      on E:Exception do
        MessageDlg(Format('There was an error calling the Spell Checker (%s) - '+
                          'you may need to close some Windows Applications and try again',
                          [E.message]), mtError, [mbOk], 0);
    end;
  end;
end;

procedure TSpellCheck.UpdateTarget(Target: TObject);
begin
  inherited;
  Enabled := Length(GetControl(Target).Text) > 0;
end;



type
  TSpellCheckActionClass = class of TSpellCheck;
  TEditActionClass = class of TEditAction;

  TEditActionWrapper = class(StdActns.TEditAction);

  TSpellCheckEditActionInfo = record
    SpellCheckActionClass: TSpellCheckActionClass;
    EditActionClass: TEditActionClass;
    DefaultCaption: string;
    DefaultHint: string;
    DefaultImageIndex: Integer;
    DefaultShortCut: TShortCut;
  end;

  TStandardActionsEx = class(TStandardActions)
  protected
    procedure CreateByInfo(AEditActionsInfo: TSpellCheckEditActionInfo);
    function FindEditActionByClassType(AEditActionClass: TEditActionClass): TEditAction;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{purpose: Add default properties of future actions here...}
const
  CH4EditActionsCount = 1;
  CH4EditActionsInfo: array [0..CH4EditActionsCount-1] of TSpellCheckEditActionInfo =
  (
    ( SpellCheckActionClass: TSpellCheck;
      EditActionClass: TEditAction;
      DefaultCaption: '&Spell Check';
      DefaultHint: 'Spell Check|Check for Spellings and Grammer.';
      DefaultImageIndex: -1;
      DefaultShortCut: VK_F7)
  );

constructor TStandardActionsEx.Create(AOwner: TComponent);
var
  I: Integer;
begin
  inherited;
  for I := Low(CH4EditActionsInfo) to High(Ch4EditActionsInfo) do
    CreateByInfo(CH4EditActionsInfo[I]);
end;

procedure TStandardActionsEx.CreateByInfo(AEditActionsInfo: TSpellCheckEditActionInfo);
var
  AEditAction: TEditAction;
  ASpellCheckEditAction: TEditAction;
begin
  AEditAction := FindEditActionByClassType(AEditActionsInfo.EditActionClass);
  ASpellCheckEditAction := AEditActionsInfo.SpellCheckActionClass.Create(Self);
  with ASpellCheckEditAction do
  begin
    if AEditAction <> nil then
    begin
      Caption := TEditActionWrapper(AEditAction).Caption;
      Hint := TEditActionWrapper(AEditAction).Hint;
      ImageIndex := TEditActionWrapper(AEditAction).ImageIndex;
      ShortCut := TEditActionWrapper(AEditAction).ShortCut;
    end
    else
    begin
      Caption := AEditActionsInfo.DefaultCaption;
      Hint := AEditActionsInfo.DefaultHint;
      ImageIndex := AEditActionsInfo.DefaultImageIndex;
      ShortCut := AEditActionsInfo.DefaultShortCut;
    end;
  end;
end;

function TStandardActionsEx.FindEditActionByClassType(AEditActionClass: TEditActionClass): TEditAction;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to ComponentCount - 1 do
    if (Components[I].ClassType = AEditActionClass) and (Components[I] is TEditAction) then
    begin
      Result := Components[I] as TEditAction;
      Break;
    end;
end;

procedure Register;
begin
  RegisterActions('Edit', [TSpellCheck], TStandardActionsEx);
end;

// these constants used to identify the window class of Word's dialog box
const
  //Constants for MS Word
   MSDialogWndClass2000 = 'bosa_sdm_Microsoft Word 9.0';
   MSDialogWndClass97 = 'bosa_sdm_Microsoft Word 8.0';
   MSWordWndClass = 'OpusApp';
   CSpellerVersion = '1.0';

function IsWordPresent: Boolean;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CLASSES_ROOT;
    Result := Reg.KeyExists('Word.Application');
  finally
    Reg.Free;
  end;
end;

{ TSpellCheck }
function TSpellCheck.GetCheckGWS: Boolean;
begin
  Result := False;
  if FConnected then Result := FWordApp.Options.CheckGrammarWithSpelling;
end;

function TSpellCheck.GetGrammarErrors: Integer;
begin
  if FConnected then
    Result := FRange.GrammaticalErrors.Count
  else
    Result := 0;
end;

function TSpellCheck.GetSpellChecked: Boolean;
// returns false if spelling has yet to be checked
begin
  Result := True;
  if FConnected then Result := not FRange.SpellingChecked;
end;

function TSpellCheck.GetSpellErrors: Integer;
begin
  if FConnected then
    Result := FRange.SpellingErrors.Count
  else
    Result := 0;
end;

function TSpellCheck.GetUserCancel: Boolean;
begin
  Result := FCancel;
end;

function TSpellCheck.GetVersion: string;
begin
  Result := CSpellerVersion;
end;

function TSpellCheck.GetWordVersion: string;
begin
  Result := FWordVersion;
end;

procedure TSpellCheck.SetCheckGWS(const Value: Boolean);
begin
  if FConnected then FWordApp.Options.CheckGrammarWithSpelling := Value;
end;

function TSpellCheck.Internal_checkGrammar: Boolean;
begin
  SetWindowPos(FHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE + SWP_HIDEWINDOW); // ensures dialogs appear in front
  FWordDoc.TrackRevisions := True; // note if changes are made
  FNumChanges := 0;

  FRange.GrammarChecked := False;
  if (FLanguage > 0) then // 0 means use the default setting
    FRange.LanguageID := SpellLanguage[FLanguage].ID;

  StartTimer;
  OleCheck(FRange.CheckGrammar);
  StopTimer;

  FCancel := not FRange.GrammarChecked;
  FWordApp.Visible := False; // need to stop ActiveDocument appearing

  FNumChanges := FRange.Revisions.Count; // seems revisions counts the old word and the new one separately
  Result := (FRange.Revisions.Count > 0);
  if Result then FRange.Revisions.AcceptAll; // accept all changes

  FWordDoc.TrackRevisions := False; // don't track future changes
end;

function TSpellCheck.Internal_checkSpelling: Boolean;
begin
  SetWindowPos(FHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE + SWP_HIDEWINDOW); // ensures dialogs appear in front
  FWordDoc.TrackRevisions := True; // note if changes are made
  FNumChanges := 0;

  if (FLanguage > 0) then // 0 means use the default setting
     FRange.LanguageID := SpellLanguage[FLanguage].ID;

  StartTimer;
  OleCheck(FWordDoc.CheckSpelling);
  StopTimer;

  FCancel := not FWordDoc.SpellingChecked;
  FWordApp.Visible := False; // need to stop ActiveDocument appearing

  FNumChanges := FRange.Revisions.Count; // seems revisions counts the old word and the new one separately
  Result := (FRange.Revisions.Count > 0);
  if Result then FRange.Revisions.AcceptAll; // accept all changes

  FWordDoc.TrackRevisions := False; // don't track future changes
end;

procedure TSpellCheck.StartTimer;
begin
  if FUseSpellCaption then
  begin
    FTimer.Caption := FSpellCaption;
    FTimer.Resume;
  end;
end;

procedure TSpellCheck.StopTimer;
begin
  FTimer.Suspend;
end;

function TSpellCheck.AddCustomDic(const FileName: string): Integer;
begin
  FCustDics.Add(FileName);
  Result := FCustDics.Count;
end;

function TSpellCheck.CheckClipboardGrammar: Boolean;
// returns true if changes were made. Corrected text is on the clipboard
begin
   Result := False;
   if not FConnected then Connect;
   if not FConnected then Exit; // if still not connected then no MS Word!

   if FConnected then
   begin
      FRange.Paste; // replace with new text to check
      Result := Internal_CheckGrammar;
      if Result then FRange.Copy;
   end;
end;

function TSpellCheck.CheckClipboardSpell: Boolean;
// returns true if changes were made. Corrected text is on the clipboard
begin
   Result := False;
   if not FConnected then Connect;
   if not FConnected then Exit; // if still not connected then no MS Word!
   if FConnected then
   begin
      FRange.Paste; // replace with new text to check
      Result := Internal_checkSpelling;
      if Result then FRange.Copy; // put onto clipboard
   end;
end;

function TSpellCheck.CheckGrammar(const Text: string): Boolean;
// returns true if changes were made and the corrected text is placed in the Text string
begin
   Result := False;
   if not FConnected then Connect;
   if not FConnected then Exit; // if still not connected then no MS Word!
   if FConnected then
   begin
      FChangedText := EmptyStr;
      FRange.Text := Text; // replace with new text to check
      Result := Internal_CheckGrammar;
      if Result then FChangedText := FRange.Text;
   end;
end;

function TSpellCheck.CheckSpelling(const Text: string): Boolean;
// returns true if changes were made and the corrected text is placed in the Text string
begin
   Result := False;
   if not FConnected then Connect;
   if not FConnected then Exit; // if still not connected then no MS Word!
   if FConnected then
   begin
      FChangedText := EmptyStr;
      FRange.Text := Text; // replace with new text to check
      Result := Internal_CheckSpelling;
      if Result then FChangedText := FRange.Text;
   end
   else
      Result := False;
end;

procedure TSpellCheck.ClearText;
begin
  if FConnected then FRange.Text := EmptyStr;
end;

procedure TSpellCheck.Connect;
var
  s: string;
begin
  if FConnected then Exit; // don't create two instances
  try
    FWordApp := CreateOleObject('Word.Application');
    FConnected := True;
    FWordApp.Visible := False; // hides the application
    FWordApp.ScreenUpdating := False; // speed up winword's processing
    FWordApp.WindowState := $00000002; // minimise
    FWordDoc := FWordApp.Documents.Add(EmptyParam, False); // this will hold the text to be checked
    FRange := FWordDoc.Range;
    FRange.WholeStory; // makes FRange point to all text in document
    FCustDics := FWordApp.CustomDictionaries;
    FWordVersion := FWordApp.Version;
    s := FWordDoc.Name + ' - ' + FWordApp.Name;
    FHandle := FindWindow(MSWordWndClass, PChar(s)); // winword
    if FWordVersion[1] = '9' then
      FWordDialogClass := MSDialogWndClass2000
    else
      FWordDialogClass := MSDialogWndClass97;

    FTimer := TWordTimer.Create(True);
    FTimer.Delay := 50; // every 0.05 s
    FTimer.DialogWndClass := FWordDialogClass;
    FTimer.FreeOnTerminate := True;

  except
    FWordApp := Unassigned;
    FConnected := False;
    if Assigned(FTimer) then
    begin
      FTimer.Terminate;
      while FTimer.Suspended do
        FTimer.Resume;
    end;
    FTimer := nil;
    MessageDlg('Unable to initialise MS Word', mtError, [mbYes], 0);
  end;
end;

constructor TSpellCheck.Create(AOwner: TComponent);
var
  init: Integer;
begin
  inherited;
  FConnected := False;
  FCancel := False;
  FChangedText := EmptyStr;
  Init := CoInitialize(nil);
  if (Init = S_OK) or (Init = S_FALSE) then
    FOleOn := True
  else
    raise EOleSysError.CreateFmt('Error initialising COM library', []);

  FSpellCaption := EmptyStr;
  FUseSpellCaption := False;
  FLanguage := 0;
end;

destructor TSpellCheck.Destroy;
begin
  Disconnect;
  if FOleOn then CoUninitialize;
  inherited;
end;

procedure TSpellCheck.Disconnect;
var
  savechanges: OleVariant;
begin
  if not VarIsEmpty(FWordApp) then
  begin
    savechanges := False;
    FWordApp.Quit(savechanges); // don't save changes
    FRange := Unassigned;
    FWordDoc := Unassigned;
    FWordApp := Unassigned;
    FCustDics := Unassigned;
    FConnected := False;
    if Assigned(FTimer) then
    begin
      FTimer.Terminate;
      while FTimer.Suspended do
        FTimer.Resume; // need this in case thread was never started
    end;
    FTimer := nil;
  end;
end;

procedure TSpellCheck.RemoveCustomDic(const Name: string);
var
  dic: OleVariant;
begin
  dic := FCustDics.Item(Name);
  if not VarIsEmpty(dic) then
    dic.Delete;
  dic := Unassigned;
end;

procedure TSpellCheck.RemoveCustomDic(const Index: Integer);
var
  dic: OleVariant;
begin
  dic := FCustDics.Item(Index);
  if not VarIsEmpty(dic) then
    dic.Delete;
  dic := Unassigned;
end;

procedure TSpellCheck.ResetIgnoreAll;
begin
  if FConnected then
  begin
    FRange.Text := ''; // ResetIgnoreAll performs an automatic spell check
    FWordApp.ResetIgnoreAll;
  end;
end;

procedure TSpellCheck.SpellingOptions;
begin
  BringWindowToTop(FHandle); // ensures that dialog opens on top
  FWordApp.Dialogs.Item($000000D3).Show;
  FWordApp.Visible := False;
end;

procedure TSpellCheck.SetLanguage(Value: TSpellLanguage);
begin
  FLanguage := Value;
end;

{ TWordTimer }
procedure TWordTimer.SetDelay(Value: Integer);
begin
  if (Value > 0) then FDelay := Value;
end;

procedure TWordTimer.Execute;
var
  h: HWND;
begin
  while not Terminated do
  begin
    sleep(FDelay); // use this as a rough timer
    if (FDialogWndClass <> EmptyStr) then
    begin
      h := FindWindow(PChar(FDialogWndClass), nil);
      if (h <> 0) and (not FPopUpExists) then
      // only change caption if the window has just appeared
      begin
        SetWindowText(h, PChar(FCaption));
        FPopUpExists := True;
      end else
        FPopUpExists := False;
    end;
  end;
end;

constructor TWordTimer.Create(CreateSuspended: Boolean);
begin
  FDelay := 100; // default delay (ms)
  inherited Create(CreateSuspended);
end;

procedure TWordTimer.Resume;
begin
  FPopUpExists := False;
  inherited;
end;

end.

.Net Color codes in Delphi

Recently we had requirement where we need to show some of the dot net colours in Delphi app. So, I have converted some of the predefined .NET colour codes to Delphi Hex format. Hope you guys find it useful.
I really appreciate if you have something to add to the list. ;-)

const
  clAmber = TColor($004094FF);
  clAliceBlue = TColor($00FFF8F0);
  clAntiqueWhite = TColor($00D7EBFA);
  clAqua = TColor($00FFFF00);
  clAquamarine = TColor($00D4FF7F);
  clAzure = TColor($00FFFFF0);
  clBeige = TColor($00DCF5F5);
  clBisque = TColor($00C4E4FF);
  clBlanchedAlmond = TColor($00CDEBFF);
  clBlueViolet = TColor($00E22B8A);
  clBrown = TColor($002A2AA5);
  clBurlyWood = TColor($0087B8DE);
  clCadetBlue = TColor($00A09E5F);
  clChartreuse = TColor($0000FF7F);
  clChocolate = TColor($001E69D2);
  clCoral = TColor($00507FFF);
  clCornflowerBlue = TColor($00ED9564);
  clCornsilk = TColor($00DCF8FF);
  clCrimson = TColor($003C14DC);
  clCyan = TColor($00FFFF00);
  clDarkBlue = TColor($008B0000);
  clDarkCyan = TColor($008B8B00);
  clDarkGoldenrod = TColor($000B86B8);
  clDarkGray = TColor($00A9A9A9);
  clDarkGreen = TColor($00006400);
  clDarkKhaki = TColor($006BB7BD);
  clDarkMagenta = TColor($008B008B);
  clDarkOliveGreen = TColor($002F6B55);
  clDarkOrange = TColor($00008CFF);
  clDarkOrchid = TColor($00CC3299);
  clDarkRed = TColor($0000008B);
  clDarkSalmon = TColor($007A96E9);
  clDarkSeaGreen = TColor($008BBC8F);
  clDarkSlateBlue = TColor($008B3D48);
  clDarkSlateGray = TColor($004F4F2F);
  clDarkTurquoise = TColor($00D1CE00);
  clDarkViolet = TColor($00D30094);
  clDeepPink = TColor($009314FF);
  clDeepSkyBlue = TColor($00FFBF00);
  clDimGray = TColor($00696969);
  clDodgerBlue = TColor($00FF901E);
  clFirebrick = TColor($002222B2);
  clFloralWhite = TColor($00F0FAFF);
  clForestGreen = TColor($00228B22);
  clFuchsia = TColor($00FF00FF);
  clGainsboro = TColor($00DCDCDC);
  clGhostWhite = TColor($00FFF8F8);
  clGold = TColor($0000D7FF);
  clGoldenrod = TColor($0020A5DA);
  clGreenYellow = TColor($002FFFAD);
  clHoneydew = TColor($00F0FFF0);
  clHotPink = TColor($00B469FF);
  clIndianRed = TColor($005C5CCD);
  clIndigo = TColor($0082004B);
  clIvory = TColor($00F0FFFF);
  clKhaki = TColor($008CE6F0);
  clLavender = TColor($00FAE6E6);
  clLavenderBlush = TColor($00F5F0FF);
  clLawnGreen = TColor($0000FC7C);
  clLemonChiffon = TColor($00CDFAFF);
  clLightBlue = TColor($00E6D8AD);
  clLightCoral = TColor($008080F0);
  clLightCyan = TColor($00FFFFE0);
  clLightGoldenrodYellow = TColor($00D2FAFA);
  clLightGray = TColor($00D3D3D3);
  clLightGreen = TColor($0090EE90);
  clLightPink = TColor($00C1B6FF);
  clLightSalmon = TColor($007AA0FF);
  clLightSeaGreen = TColor($00AAB220);
  clLightSkyBlue = TColor($00FACE87);
  clLightSlateGray = TColor($00998877);
  clLightSteelBlue = TColor($00DEC4B0);
  clLightYellow = TColor($00E0FFFF);
  clLimeGreen = TColor($0032CD32);
  clLinen = TColor($00E6F0FA);
  clMediumAquamarine = TColor($00AACD66);
  clMediumBlue = TColor($00CD0000);
  clMediumOrchid = TColor($00D355BA);
  clMediumPurple = TColor($00DB7093);
  clMediumSeaGreen = TColor($0071B33C);
  clMediumSlateBlue = TColor($00EE687B);
  clMediumSpringGreen = TColor($009AFA00);
  clMediumTurquoise = TColor($00CCD148);
  clMediumVioletRed = TColor($008515C7);
  clMidnightBlue = TColor($00701919);
  clMintCream = TColor($00FAFFF5);
  clMistyRose = TColor($00E1E4FF);
  clMoccasin = TColor($00B5E4FF);
  clNavajoWhite = TColor($00ADDEFF);
  clOldLace = TColor($00E6F5FD);
  clOliveDrab = TColor($00238E6B);
  clOrange = TColor($0000A5FF);
  clOrangeRed = TColor($000045FF);
  clOrchid = TColor($00D670DA);
  clPaleGoldenrod = TColor($00AAE8EE);
  clPaleGreen = TColor($0098FB98);
  clPaleTurquoise = TColor($00EEEEAF);
  clPaleVioletRed = TColor($009370DB);
  clPapayaWhip = TColor($00D5EFFF);
  clPeachPuff = TColor($00B9DAFF);
  clPeru = TColor($003F85CD);
  clPlum = TColor($00DDA0DD);
  clPowderBlue = TColor($00E6E0B0);
  clRosyBrown = TColor($008F8FBC);
  clRoyalBlue = TColor($00E16941);
  clSaddleBrown = TColor($0013458B);
  clSalmon = TColor($007280FA);
  clSandyBrown = TColor($0060A4F4);
  clSeaGreen = TColor($00578B2E);
  clSeaShell = TColor($00EEF5FF);
  clSienna = TColor($002D52A0);
  clSkyBlue = TColor($00EBCE87);
  clSlateBlue = TColor($00CD5A6A);
  clSlateGray = TColor($00908070);
  clSnow = TColor($00FAFAFF);
  clSpringGreen = TColor($007FFF00);
  clSteelBlue = TColor($00B48246);
  clTan = TColor($008CB4D2);
  clThistle = TColor($00D8BFD8);
  clTomato = TColor($004763FF);
  clTransparent = TColor($00C8D0D4);
  clWheat = TColor($00B3DEF5);
  clWhiteSmoke = TColor($00F5F5F5);
  clYellowGreen = TColor($0032CD9A);

Draw Grabber Line on Canvas / Form

Below is the code snippet to draw a Grabber line... Its all self explainatory

const
  GrabberSize = 12;

procedure TForm1.DoPaintSidePanel();

procedure DrawGrabberLine(ALeft, ATop, ARight, ABottom: Integer);
begin
  with Canvas do
  begin
    Pen.Color := clBtnHighlight;
    MoveTo(ARight, ATop);
    LineTo(ALeft, ATop);
    LineTo(ALeft, ABottom);
    Pen.Color := clBtnShadow;
    LineTo(ARight, ABottom);
    LineTo(ARight, ATop-1);
  end;
end;
begin
  Canvas.Lock;
  try
    DrawGrabberLine(3, 12, 5, Height-2);
    DrawGrabberLine(6, 12, 8, Height-2);
  finally
    Canvas.Unlock;
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  DoPaintSidePanel();
end;

Replacing special characters from SOAP object / DB string

Finding the special characters in XML / SOAP / Database string sometimes it is painful. I've recently come across similar situation where user has copied the text from Word document and paste in Rich text editor / text editor. Error has occurred while processing the text to deserialize / saving it to database.
Code below is used to replace some known special character but you can keep adding the list if you wish.

    // Unicode function
    public static string GetUnicodeString(string s)
    {
          byte[] unicodeByte = Encoding.Unicode.GetBytes(s);
          string unicodechars = (Encoding.Default.GetString(unicodeByte)).ToString().Replace("\0", "").Replace("\f", "").Replace("", "");
          return (unicodechars);
    }

    public static string GetUnicodeString(string s, bool replaceQuotes)
    {
      //Replace MS Word quotes with standard quotes (Oracle seems to store only 7-bit ASCII)
      if (replaceQuotes)
      {
        if (s.IndexOfAny(new char[] { (char)8220, (char)8221, (char)8217, (char)8216 }) != -1)
        {
          s = s.Replace((char)8220, '\'').Replace((char)8221, '\'').Replace((char)8217, (char)34).Replace((char)8216, (char)34);
        }
      }
      return (GetUnicodeString(s));
    }
  }

Hope this helps.

Development Continues...

Cut, Copy, Paste events on TextBox & ComboBox in C# .NET

Well, I have been wondering why .NET hasn't got the Cut, Copy, Paste events on editor controls like TextBox, RichTextEditor, ListView, ComboBox and TreeView ???
Anyways, here I have got these events for you...
First we will extend / inherit the standard TextBox to TextBoxEx as in TextBoxEx.cs below

using System;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Globalization;
using System.Text;
using System.Windows.Forms;

namespace KurapatySolutions.Controls
{
 public partial class TextBoxEx : TextBox
 {
  #region - Constants -
  private const int WM_CUT = 0x0300;
  private const int WM_COPY = 0x0301;
  private const int WM_PASTE = 0x0302;
  #endregion

  #region - Constructor -
  public TextBoxEx()
  {
   InitializeComponent();
  }
  #endregion

  #region - Private Methods -
  private void DoOnCutText()
  {
   if (OnCutText != null)
    OnCutText(this, new ClipboardEventArgs(SelectedText));
  }
  private void DoOnCopyText()
  {
   if (OnCopyText != null)
    OnCopyText(this, new ClipboardEventArgs(SelectedText));
  }
  private void DoOnPasteText()
  {
  if (OnPasteText != null)
  OnPasteText(this, new ClipboardEventArgs(Clipboard.GetText()));
  }
  #endregion

  #region - Event Handlers -
  public event ClipboardEventHandler OnCutText;
  public event ClipboardEventHandler OnCopyText;
  public event ClipboardEventHandler OnPasteText;
  #endregion

  #region - WndProc - Handler -
  protected override void WndProc(ref Message m)
  {
   base.WndProc(ref m);
   if (m.Msg == WM_CUT)
   {
    //Cut Event
    DoOnCutText();
   }
   else if (m.Msg == WM_COPY)
   {
    //Copy Event
    DoOnCopyText();
   }
   else if (m.Msg == WM_PASTE)
   {
    //Paste Event
    DoOnPasteText();
   }   
  }
  #endregion
 }
 public class ClipboardEventArgs : EventArgs
 {
  public string ClipboardText { get; set; }

  public ClipboardEventArgs(string clipboardText)
  {
   ClipboardText = clipboardText;
  }
 }
public delegate void ClipboardEventHandler(object sender, ClipboardEventArgs e);
}

Now that the new control is ready, build your project and use the new events.

In second example, we will inherit standard ComboBox to ComboBoxEx control, this would require some kind of hacking with NativeWindow... see the code below and you will understand as its self explanatory.

using System;
using System.Runtime.InteropServices;
using System.Windows.Forms;
using System.ComponentModel;

namespace KurapatySolutions.Controls
{
 /// 

 /// ComboBox with extended functionality to support Cut, Copy & Paste events
 /// 
 public partial class ComboBoxEx : ComboBox
 {
  #region - Constants -
  private const int WM_CUT = 0x0300;
  private const int WM_COPY = 0x0301;
  private const int WM_PASTE = 0x0302;
  private const UInt32 CB_GETCOMBOBOXINFO = 0x0164;
  #endregion

  #region - DLL Import -
  [DllImport("USER32", EntryPoint = "SendMessage")]
  extern static void SendCbInfoMsg(IntPtr wnd, UInt32 msg, IntPtr wParam, [In, Out] ref ComboBoxInfo lParam);
  #endregion

  #region - Constructor -
  public ComboBoxEx()
  {
   InitializeComponent();
  }
  public ComboBoxEx(IContainer container)
  {
   container.Add(this);
   InitializeComponent();
  }
  #endregion

  #region - Private Members -
  private NativeWindowEx _nativeWindowEx;
  #endregion

  #region - Private Methods -
  private void DoOnCutText(object sender, EventArgs e)
  {
   if (OnCutText != null)
    OnCutText(sender, new ClipboardEventArgs(SelectedText));
  }
  private void DoOnCopyText(object sender, EventArgs e)
  {
   if (OnCopyText != null)
    OnCopyText(sender, new ClipboardEventArgs(SelectedText));
  }
  private void DoOnPasteText(object sender, ClipboardEventArgs e)
  {
   if (OnPasteText != null)
    OnPasteText(this, e);
  }
  #endregion

  #region - Event Handlers -
  public event ClipboardEventHandler OnCutText;
  public event ClipboardEventHandler OnCopyText;
  public event ClipboardEventHandler OnPasteText;
  #endregion
        
  #region - Private Structures & Class -
  struct Rect
  {
   public int Left;
   public int Top;
   public int Right;
   public int Bottom;
  }

  struct ComboBoxInfo
  {
   public Int32 cbSize;
   public Rect rcItem;
   public Rect rcButton;
   public Int32 buttonState;
   public IntPtr hwndCombo;
   public IntPtr hwndEdit;
   public IntPtr hwndList;
  }

  /// 

  /// This window is inherited from NativeWindow and overrides WndProc.
  /// 
  class NativeWindowEx : NativeWindow 
  {
   #region - Event Handlers -
   public event EventHandler OnCutText;
   public event EventHandler OnCopyText;
   public event ClipboardEventHandler OnPasteText;
   #endregion

   #region - Private Methods -
   private void DoOnCutText()
   {
    if (OnCutText != null)
     OnCutText(this, new EventArgs());
   }

   private void DoOnCopyText()
   {
    if (OnCopyText != null)
     OnCopyText(this, new EventArgs());
   }

   private void DoOnPasteText()
   {
    if (OnPasteText != null)
     OnPasteText(this, new ClipboardEventArgs(Clipboard.GetText()));
   }
   #endregion

   #region - WndProc - Handler -
   protected override void WndProc(ref Message m)
   {
    if (m.Msg == WM_CUT)
    {
     DoOnCutText();
    }
    if (m.Msg == WM_COPY)
    {
     DoOnCopyText();
    }
    if (m.Msg == WM_PASTE)
    {
     DoOnPasteText();
    }
    base.WndProc(ref m);
   }
   #endregion
  }
  #endregion

  #region - Overrides -
  protected override void OnHandleCreated(EventArgs e)
  {
   var cbInfo = new ComboBoxInfo();
   cbInfo.cbSize = Marshal.SizeOf(cbInfo);
   SendCbInfoMsg(Handle, CB_GETCOMBOBOXINFO, IntPtr.Zero, ref cbInfo);
   _nativeWindowEx = new NativeWindowEx();
   _nativeWindowEx.AssignHandle(cbInfo.hwndEdit);
   _nativeWindowEx.OnCutText += DoOnCutText;
   _nativeWindowEx.OnCopyText += DoOnCopyText;
   _nativeWindowEx.OnPasteText += DoOnPasteText;
   base.OnHandleCreated(e);

  }
  #endregion
 }
 public class ClipboardEventArgs : EventArgs
 {
  public string ClipboardText { get; set; }

  public ClipboardEventArgs(string clipboardText)
  {
   ClipboardText = clipboardText;
  }
 }
 public delegate void ClipboardEventHandler(object sender, ClipboardEventArgs e);
}

You can move the shared EventArgs & Delegate to EventDelegate.cs as mentioned below:

using System;

namespace KurapatySolutions.Controls
{
 public class ClipboardEventArgs : EventArgs
 {
  public string ClipboardText { get; set; }

  public ClipboardEventArgs(string clipboardText)
  {
   ClipboardText = clipboardText;
  }
 }
 public delegate void ClipboardEventHandler(object sender, ClipboardEventArgs e);
}

Hope it helps!

Development Continues...

Windows Key Combination

Not Delphi/C# this time but Windows XP -rather, for those who still using antique version ;-)
Below is the key combination with “Windows” key and press
L: Lock screen
R: Start-> Run
E: Explorer window
F: Find window
D: shows Desktop (press again to restore)
M: Minimize all (won't restore them afterwards)
Pause/Break: System properties/My Computer properties
Tab: switch between process buttons in the Taskbar (you will not notice anything on your screen, look at your taskbar and press enter to activate) and finally mutant hybrid of alt-tab is Alt-Esc

Commandline HelperClass in C#

using System;
using System.Collections.Generic;
using System.Collections.ObjectModel;
using System.Text;
using System.Text.RegularExpressions;

namespace Kurapaty.Solutions.Utils
{
	/// 

	/// Commandline Arguments Parser class
	/// 
	/// 
	/// Source: 
	/// 
	public class Arguments
	{
		/// 

		/// Splits the command line. When main(string[] args) is used escaped quotes (ie a path “c:\folder\”)
		/// Will consume all the following command line arguments as the one argument. 
		/// This function ignores escaped quotes making handling paths much easier.
		/// 
		/// The command line.		/// 
		public static string[] SplitCommandLine(string commandLine)
		{
			var translatedArguments = new StringBuilder(commandLine);
			var escaped = false;
			for (var i = 0; i < translatedArguments.Length; i++)
			{
				if (translatedArguments[i] == '"')
				{
					escaped = !escaped;
				}
				if (translatedArguments[i] == ' ' && !escaped)
				{
					translatedArguments[i] = '\n';
				}
			}

			var toReturn = translatedArguments.ToString().Split(new[] { '\n' }, StringSplitOptions.RemoveEmptyEntries);
			for (var i = 0; i < toReturn.Length; i++)
			{
				toReturn[i] = RemoveMatchingQuotes(toReturn[i]);
			}
			return toReturn;
		}

		public static string RemoveMatchingQuotes(string stringToTrim)
		{
			var firstQuoteIndex = stringToTrim.IndexOf('"');
			var lastQuoteIndex = stringToTrim.LastIndexOf('"');
			while (firstQuoteIndex != lastQuoteIndex)
			{
				stringToTrim = stringToTrim.Remove(firstQuoteIndex, 1);
				stringToTrim = stringToTrim.Remove(lastQuoteIndex - 1, 1); //-1 because we’ve shifted the indicies left by one
				firstQuoteIndex = stringToTrim.IndexOf('"');
				lastQuoteIndex = stringToTrim.LastIndexOf('"');
			}

			return stringToTrim;
		}

		private readonly Dictionary> _parameters;
		private string _waitingParameter;

		public Arguments(IEnumerable arguments)
		{
			_parameters = new Dictionary>();

			string[] parts;

			//Splits on beginning of arguments ( – and — and / )
			//And on assignment operators ( = and : )
			var argumentSplitter = new Regex(@"^-{1,2}|^/|=|:", RegexOptions.IgnoreCase | RegexOptions.Compiled);

			foreach (var argument in arguments)
			{
				parts = argumentSplitter.Split(argument, 3);
				switch (parts.Length)
				{
					case 1:
						AddValueToWaitingArgument(parts[0]);
						break;
					case 2:
						AddWaitingArgumentAsFlag();

						//Because of the split index 0 will be a empty string
						_waitingParameter = parts[1];
						break;
					case 3:
						AddWaitingArgumentAsFlag();

						//Because of the split index 0 will be a empty string
						string valuesWithoutQuotes = RemoveMatchingQuotes(parts[2]);

						AddListValues(parts[1], valuesWithoutQuotes.Split(','));
						break;
				}
			}

			AddWaitingArgumentAsFlag();
		}

		private void AddListValues(string argument, IEnumerable values)
		{
			foreach (var listValue in values)
			{
				Add(argument, listValue);
			}
		}

		private void AddWaitingArgumentAsFlag()
		{
			if (_waitingParameter == null) return;

			AddSingle(_waitingParameter, "true");
			_waitingParameter = null;
		}

		private void AddValueToWaitingArgument(string value)
		{
			if (_waitingParameter == null) return;

			value = RemoveMatchingQuotes(value);

			Add(_waitingParameter, value);
			_waitingParameter = null;
		}

		/// 

		/// Gets the count.
		/// 
		/// The count.
		public int Count
		{
			get
			{
				return _parameters.Count;
			}
		}

		/// 

		/// Adds the specified argument.
		/// 
		/// The argument.		/// The value.		public void Add(string argument, string value)
		{
			if (!_parameters.ContainsKey(argument))
				_parameters.Add(argument, new Collection());

			_parameters[argument].Add(value);
		}

		public void AddSingle(string argument, string value)
		{
			if (!_parameters.ContainsKey(argument))
				_parameters.Add(argument, new Collection());
			else
				throw new ArgumentException(string.Format("Argument {0} has already been defined", argument));

			_parameters[argument].Add(value);
		}

		public void Remove(string argument)
		{
			if (_parameters.ContainsKey(argument))
				_parameters.Remove(argument);
		}

		/// 

		/// Determines whether the specified argument is true.
		/// 
		/// The argument.		/// 
		///     true if the specified argument is true; otherwise, false.
		/// 
		public bool IsTrue(string argument)
		{
			AssertSingle(argument);

			var arg = this[argument];

			return arg != null && arg[0].Equals("true", StringComparison.OrdinalIgnoreCase);
		}

		public bool IsExists(string argument)
		{
			return IsTrue(argument);
		}

		private void AssertSingle(string argument)
		{
			if (this[argument] != null && this[argument].Count > 1)
				throw new ArgumentException(string.Format("{0} has been specified more than once, expecting single value", argument));
		}

		public string Single(string argument)
		{
			AssertSingle(argument);

			//only return value if its NOT true, there is only a single item for that argument
			//and the argument is defined
			if (this[argument] != null && !IsTrue(argument))
				return this[argument][0];

			return null;
		}

		public bool Exists(string argument)
		{
			return (this[argument] != null && this[argument].Count > 0);
		}

		/// 

		/// Gets the  with the specified parameter.
		/// 
		/// 
		public Collection this[string parameter]
		{
			get
			{
				return _parameters.ContainsKey(parameter) ? _parameters[parameter] : null;
			}
		}
	}
}

Usage:

		private bool ProcessCommandLineParameters()
		{
			// Usage: -ec -source:"C:\Temp\formDefinition.txt" -target:"C:\Temp\formDefinition.enc"
			try
			{
				Arguments parser = new Arguments(Arguments.SplitCommandLine(Environment.CommandLine));

				if (parser.IsExists("help") || parser.IsExists("?"))
					ShowUsageHelpMessage();

				if (parser.Exists("source") && 1 == parser["source"].Count) tbSource.Text = parser.Single("source");
				if (parser.Exists("target") && 1 == parser["target"].Count) tbTarget.Text = parser.Single("target");

				if (parser.Exists("ec") && parser.IsTrue("ec"))
				{
					button1_Click(null, null);
					return true;
				}
				if (parser.Exists("dc") && parser.IsTrue("dc"))
				{
					button2_Click(null, null);
					return true;
				}
			}
			catch (Exception)
			{
				MessageBox.Show("Invalid commandline arguments passed. Please use GUI or type \"help\" at commandline.",
				                "Commandline processor", MessageBoxButtons.OK, MessageBoxIcon.Information);
			}
			return false;
		}

Delphi 6 Commandline Helper Class

unit uCmdLineHelper;

interface

uses Windows, Classes, SysUtils;

  type
  TCommandLineHelper = class(TObject)
  private
    function GetNextParam(var CmdLine: PChar; Buffer: PChar; Len: PInteger): Boolean;
    function GetParamCount: Integer;
    function GetCommandLine: string;
    function GetParamStr(Index: Integer): String;
    function GetHasParam(Value: String): Boolean;
  public
    property ParamStr[Index: Integer]: String read GetParamStr;
    property ParamCount: Integer read GetParamCount;
    property CommandLine: String read GetCommandLine;
    property HasParam[Value: String]: Boolean read GetHasParam;
  end;

implementation


function TCommandLineHelper.GetCommandLine : string;
begin
  result := Windows.GetCommandLine;
end;

function TCommandLineHelper.GetHasParam(Value: String): Boolean;
var
 I: Integer;
 param: String;
begin
  result := False;
  for I:= 1 to ParamCount do
  begin
    param := UpperCase(ParamStr[I]);
    Value := UpperCase(Value);
    result := ((param = Value) or
               (param = '/'+Value) or ('/'+param = Value) or
               (param = '\'+Value) or ('\'+param = Value) or
               (param = '-'+Value) or ('-'+param = Value) or
               (param = ':'+Value) or (':'+param = Value));
    if result then Exit;
  end;
end;

function TCommandLineHelper.GetNextParam(var CmdLine: PChar; Buffer: PChar; Len: PInteger): Boolean;
var
  InQuotedStr, IsOdd: Boolean;
  NumSlashes, NewLen, cnt: Integer;
begin
  Result := False;
  if Len <> nil then Len^ := 0;
  if CmdLine = nil then Exit;

  while (CmdLine^ <= ' ') and (CmdLine^ <> #0) do CmdLine := CharNext(CmdLine) ;
  if CmdLine^ = #0 then Exit;

  InQuotedStr := False;
  NewLen := 0;
  repeat
    if CmdLine^ = '\' then
    begin
      NumSlashes := 0;
      repeat
        Inc(NumSlashes) ;
        CmdLine := CharNext(CmdLine) ;
      until CmdLine^ <> '\';

      if CmdLine^ = '"' then
      begin
        IsOdd := (NumSlashes mod 2) <> 0;
        NumSlashes := NumSlashes div 2;
        Inc(NewLen, NumSlashes) ;

        if IsOdd then Inc(NewLen);

        if Buffer <> nil then
        begin
          for cnt := 0 to NumSlashes-1 do
          begin
            Buffer^ := '\';
            Inc(Buffer) ;
          end;

          if IsOdd then
          begin
            Buffer^ := '"';
            Inc(Buffer) ;
          end;
        end;
        if IsOdd then CmdLine := CharNext(CmdLine) ;
      end else
      begin
        Inc(NewLen, NumSlashes);

        if Buffer <> nil then
        begin
          for cnt := 0 to NumSlashes-1 do
          begin
            Buffer^ := '\';
            Inc(Buffer) ;
          end;
        end;
      end;
      Continue;
    end;
    if CmdLine^ <> '"' then
    begin
      if (CmdLine^ <= ' ') and (not InQuotedStr) then Break;
      Inc(NewLen) ;
      if Buffer <> nil then
      begin
        Buffer^ := CmdLine^;
        Inc(Buffer) ;
      end;
    end
    else
      InQuotedStr := not InQuotedStr;
    CmdLine := CharNext(CmdLine) ;
  until CmdLine^ = #0;
  if Len <> nil then Len^ := NewLen;
  Result := True;
end;

function TCommandLineHelper.GetParamCount: Integer;
var
  CmdLine: PChar;
begin
  Result := 0;
  CmdLine := Windows.GetCommandLine;
  GetNextParam(CmdLine, nil, nil) ;
  while GetNextParam(CmdLine, nil, nil) do Inc(Result) ;
end;

function TCommandLineHelper.GetParamStr(Index: Integer): String;
var
  Buffer: array[0..MAX_PATH] of Char;
  CmdLine, P: PChar;
  Len: Integer;
begin
  Result := '';
  if Index <= 0 then
  begin
    Len := GetModuleFileName(0, Buffer, MAX_PATH+1) ;
    SetString(Result, Buffer, Len) ;
  end else
  begin
    CmdLine := windows.GetCommandLine;
    GetNextParam(CmdLine, nil, nil) ;
    repeat
      Dec(Index) ;
      if Index = 0 then Break;
      if not GetNextParam(CmdLine, nil, nil) then Exit;
    until False;
    P := CmdLine;
    if GetNextParam(P, nil, @Len) then
    begin
      SetLength(Result, Len) ;
      GetNextParam(CmdLine, PChar(Result), nil) ;
    end;
  end;
end;

end.

Usage:

var
  idx : integer;
  helper: TCommandLineHelper;
begin
  helper:= TCommandLineHelper.Create;
  with Memo1.Lines do
  begin
    Clear;

    Add('CMD Line: ' + helper.CommandLine + #13#10) ;
    Add('Number of params: ' + IntToStr(helper.ParamCount) + #13#10) ;

    for idx := 1 to helper.ParamCount do
    begin
      Memo1.Lines.Add(helper.ParamStr[idx]) ;
    end;
      Memo1.Lines.Add('Has Param - and ? '+ BoolToStr(helper.HasParam['third'], true));
  end;
  helper.Free;
end;

Reporting Progress status using Asynchronous / BackgroundWorker

Well, this is an example to show how to create an Asynchronous methods / calls conforming to the Event-based Asynchronous pattern. This example demonstrate how to use BackgroundWorker and Asynchronous methods to report the progress status of the task you are performing.

File 1: Entity.cs

using System;
using System.ComponentModel;
using System.Threading;
using System.Runtime.Remoting.Messaging;

namespace BackgroundWorkerClient
{
 internal class Entity
 {
  #region Private Declarations
  private int _fileCount;
  private int _folderCount;
  private int _progress;
  private ProgressStatus _status = ProgressStatus.Idle;
  private bool _taskRunning;
  private readonly object _sync = new object();
  private AsyncContext _taskContext;

  #endregion

  #region Public Properties
  public bool IsBusy { get { return _taskRunning; } }
  #endregion

  #region EventHandlers & Delegates
  public event AsyncCompletedEventHandler OnTaskCompleted;
  public event TaskProgressChangedEventHandler OnTaskProgressChanged;

  private delegate void TaskWorkerDelegate(string path, AsyncOperation asyncOperation, AsyncContext asyncContext, out bool cancelled);
  #endregion

  #region Protected Virtual Methods
  protected virtual void DoOnTaskCompleted(AsyncCompletedEventArgs e)
  {
   if (OnTaskCompleted != null)
    OnTaskCompleted(this, e);
  }
  protected virtual void DoOnTaskProgressChanged(TaskProgressChangedEventArgs eventArgs)
  {
   if (OnTaskProgressChanged != null)
    OnTaskProgressChanged(this, eventArgs);
  }
  #endregion

  #region Asynchronous Operations

  private void StartProcessing(string path, AsyncOperation asyncOperation, AsyncContext asyncContext, out bool cancelled)
  {
   cancelled = false;
   _status = ProgressStatus.Started;
   _fileCount = 0;
   _folderCount = 0;
   _progress = 0;
   for (int folderCount = 0; folderCount < 100; folderCount++)
   {
    // if (_progress >= 100) _progress = 0;

    // compute progress
    // int _progress = 100 * (i + 1) / SelectedFiles.Length;

    _progress = 100 * (folderCount + 1) / 100;
    _status = ProgressStatus.ProcessingFolders;
    _folderCount = folderCount;
    path = string.Format("Project{0}", _folderCount);
    asyncOperation.Post(e => DoOnTaskProgressChanged((TaskProgressChangedEventArgs)e), new TaskProgressChangedEventArgs(_status, path, _progress, null));
    Thread.Sleep(100);
    for (int fileCount = 0; fileCount < 100; fileCount++)
    {
     _status = ProgressStatus.ProcessingFiles;
     _fileCount = fileCount;
     path = string.Format("Project{0}, Class{1}.cs", _folderCount, _fileCount);
     asyncOperation.Post(e => DoOnTaskProgressChanged((TaskProgressChangedEventArgs)e), new TaskProgressChangedEventArgs(_status, path, _progress, null));

     if (asyncContext.IsCancelling)
     {
      cancelled = true;
      _status = ProgressStatus.Stopped;
      return;
     }
     Thread.Sleep(10);
    }

    if (asyncContext.IsCancelling)
    {
     cancelled = true;
     _status = ProgressStatus.Stopped;
     return;
    }
   }
   _status = ProgressStatus.Completed;
  }
  private void TaskCompletedCallback(IAsyncResult asyncResult)
  {
   // Retrieve the delegate.
   AsyncResult result = (AsyncResult)asyncResult;
   // get the original worker delegate and the AsyncOperation instance
   TaskWorkerDelegate worker = (TaskWorkerDelegate)result.AsyncDelegate;
   AsyncOperation async = (AsyncOperation)asyncResult.AsyncState;
   bool cancelled;

   // finish the asynchronous operation
   worker.EndInvoke(out cancelled, asyncResult);

   // clear the running task flag
   lock (_sync)
   {
    _taskRunning = false;
    _taskContext = null;
   }

   // raise the completed event
   AsyncCompletedEventArgs completedArgs = new AsyncCompletedEventArgs(null, cancelled, null);
   async.PostOperationCompleted(e => DoOnTaskCompleted((AsyncCompletedEventArgs)e), completedArgs);
  }
  #endregion

  #region Public Methods
  public void StartAsync(string path)
  {
   TaskWorkerDelegate worker = StartProcessing;
   AsyncCallback completedCallback = TaskCompletedCallback;

   lock (_sync)
   {
    if (_taskRunning)
     throw new InvalidOperationException("The control is currently busy.");

    AsyncOperation async = AsyncOperationManager.CreateOperation(null);
    AsyncContext asyncContext = new AsyncContext();
    bool cancelled;
    worker.BeginInvoke(path, async, asyncContext, out cancelled, completedCallback, async);
    _taskRunning = true;
    _taskContext = asyncContext;
   }
  }
  public void CancelAsync()
  {
   lock (_sync)
   {
    if (_taskContext != null)
     _taskContext.Cancel();
   }
  }
  #endregion

 }

 internal class AsyncContext
 {
  private readonly object _sync = new object();
  private bool _isCancelling;

  public bool IsCancelling
  {
   get
   {
    lock (_sync) { return _isCancelling; }
   }
  }

  public void Cancel()
  {
   lock (_sync) { _isCancelling = true; }
  }
 }

 public enum ProgressStatus
 {
  Idle,
  Started,
  Stopped,
  Completed,
  ProcessingFiles,
  ProcessingFolders
 }

 public class TaskProgressChangedEventArgs : ProgressChangedEventArgs
 {
  public string FileName { get; private set; }
  public ProgressStatus Status { get; private set; }
  public TaskProgressChangedEventArgs(ProgressStatus status, string fileName, int progressPercent, object userState)
   : base(progressPercent, userState)
  {
   FileName = fileName;
   Status = status;
  }
 }

 public delegate void TaskProgressChangedEventHandler(object sender, TaskProgressChangedEventArgs e);
}

File 2: ProgressController.cs

using System.ComponentModel;

namespace BackgroundWorkerClient
{
 public class ProgressController
 {
  private Entity _entity;
  public event AsyncCompletedEventHandler OnCompleted;
  public event TaskProgressChangedEventHandler OnProgressChanged;

  public ProgressController()
  {
   Initialize();
  }

  private void Initialize()
  {
   _entity = new Entity();
   _entity.OnTaskCompleted += DoOnCompleted;
   _entity.OnTaskProgressChanged += DoOnProgressChanged;
  }

  public void Start(string path)
  {
   _entity.StartAsync(path);
  }

  public void Stop()
  {
   _entity.CancelAsync();
  }


  void DoOnProgressChanged(object sender, TaskProgressChangedEventArgs progressArgs)
  {
   if (OnProgressChanged != null)
    OnProgressChanged(this, progressArgs);
  }

  void DoOnCompleted(object sender, AsyncCompletedEventArgs completedArgs)
  {
   if (OnCompleted != null)
   {
    OnCompleted(this, completedArgs);  
   }
  }

 }
}

File 3: AsyncClient.cs

using System;
using System.Threading;
using System.ComponentModel;
using System.Windows.Forms;
using System.Diagnostics;

namespace BackgroundWorkerClient
{
 public class AsyncClient : Form
 {
  Label _lblStatus;
  Button _btnStart;
  Button _btnCancel;
  ProgressBar _progressBar;
  BackgroundWorker _backgroundWorker;
  CheckBox _ckUseController;
  ProgressController _controller;

  public AsyncClient()
  {
   InitializeComponent();
   InitializeController();
   SetButtons(true);
  }

  private void InitializeController()
  {
   _controller = new ProgressController();
   _controller.OnCompleted += OnControllerTaskCompleted;
   _controller.OnProgressChanged += OnControllerProgressChanged;
  }

  #region Windows Form Designer generated code
  void InitializeComponent()
  {
   this._lblStatus = new System.Windows.Forms.Label();
   this._progressBar = new System.Windows.Forms.ProgressBar();
   this._btnCancel = new System.Windows.Forms.Button();
   this._btnStart = new System.Windows.Forms.Button();
   this._backgroundWorker = new System.ComponentModel.BackgroundWorker();
   this._ckUseController = new System.Windows.Forms.CheckBox();
   this.SuspendLayout();
   // 
   // _lblStatus
   // 
   this._lblStatus.AutoSize = true;
   this._lblStatus.Location = new System.Drawing.Point(12, 25);
   this._lblStatus.Name = "_lblStatus";
   this._lblStatus.Size = new System.Drawing.Size(101, 13);
   this._lblStatus.TabIndex = 0;
   this._lblStatus.Text = "Status: Not Started";
   // 
   // _progressBar
   // 
   this._progressBar.Location = new System.Drawing.Point(12, 43);
   this._progressBar.MarqueeAnimationSpeed = 50;
   this._progressBar.Name = "_progressBar";
   this._progressBar.Size = new System.Drawing.Size(337, 21);
   this._progressBar.Style = System.Windows.Forms.ProgressBarStyle.Continuous;
   this._progressBar.TabIndex = 1;
   // 
   // _btnCancel
   // 
   this._btnCancel.Anchor = ((System.Windows.Forms.AnchorStyles)((System.Windows.Forms.AnchorStyles.Bottom | System.Windows.Forms.AnchorStyles.Left)));
   this._btnCancel.Enabled = false;
   this._btnCancel.Location = new System.Drawing.Point(274, 82);
   this._btnCancel.Name = "_btnCancel";
   this._btnCancel.Size = new System.Drawing.Size(75, 23);
   this._btnCancel.TabIndex = 2;
   this._btnCancel.Text = "&Cancel";
   this._btnCancel.Click += new System.EventHandler(this.OnCancel);
   // 
   // _btnStart
   // 
   this._btnStart.Anchor = ((System.Windows.Forms.AnchorStyles)((System.Windows.Forms.AnchorStyles.Bottom | System.Windows.Forms.AnchorStyles.Left)));
   this._btnStart.Location = new System.Drawing.Point(183, 82);
   this._btnStart.Name = "_btnStart";
   this._btnStart.Size = new System.Drawing.Size(75, 23);
   this._btnStart.TabIndex = 3;
   this._btnStart.Text = "&Start";
   this._btnStart.Click += new System.EventHandler(this.OnStart);
   // 
   // _backgroundWorker
   // 
   this._backgroundWorker.WorkerReportsProgress = true;
   this._backgroundWorker.WorkerSupportsCancellation = true;
   this._backgroundWorker.DoWork += new System.ComponentModel.DoWorkEventHandler(this.OnDoWork);
   this._backgroundWorker.RunWorkerCompleted += new System.ComponentModel.RunWorkerCompletedEventHandler(this.OnCompleted);
   this._backgroundWorker.ProgressChanged += new System.ComponentModel.ProgressChangedEventHandler(this.OnProgressChanged);
   // 
   // _ckUseController
   // 
   this._ckUseController.Anchor = ((System.Windows.Forms.AnchorStyles)((System.Windows.Forms.AnchorStyles.Bottom | System.Windows.Forms.AnchorStyles.Left)));
   this._ckUseController.AutoSize = true;
   this._ckUseController.Location = new System.Drawing.Point(15, 86);
   this._ckUseController.Name = "_ckUseController";
   this._ckUseController.Size = new System.Drawing.Size(141, 17);
   this._ckUseController.TabIndex = 4;
   this._ckUseController.Text = "&Process using Controller";
   this._ckUseController.UseVisualStyleBackColor = true;
   // 
   // AsyncClient
   // 
   this.ClientSize = new System.Drawing.Size(361, 117);
   this.Controls.Add(this._ckUseController);
   this.Controls.Add(this._lblStatus);
   this.Controls.Add(this._btnStart);
   this.Controls.Add(this._btnCancel);
   this.Controls.Add(this._progressBar);
   this.Font = new System.Drawing.Font("Tahoma", 8.25F, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, ((byte)(0)));
   this.MaximizeBox = false;
   this.MinimizeBox = false;
   this.Name = "AsyncClient";
   this.ShowInTaskbar = false;
   this.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen;
   this.Text = "Async Client";
   this.ResumeLayout(false);
   this.PerformLayout();

  }
  #endregion

  [STAThread]
  static void Main()
  {
   Application.EnableVisualStyles();
   Application.Run(new AsyncClient());
  }

  void OnDoWork(object sender, DoWorkEventArgs doWorkArgs)
  {
   Debug.Assert(doWorkArgs.Argument != null);
   BackgroundWorker backgroundWorker = sender as BackgroundWorker;
   Debug.Assert(backgroundWorker != null);

   int count = (int)doWorkArgs.Argument;

   doWorkArgs.Result = null;

   for (int progress = 0; progress <= count; progress += count / 10)
   {
    if (backgroundWorker.CancellationPending)
    {
     doWorkArgs.Cancel = true;
     break;
    }
    Thread.Sleep(500);

    backgroundWorker.ReportProgress(progress);
   }
  }

  void OnProgressChanged(object sender, ProgressChangedEventArgs progressArgs)
  {
   _progressBar.Value = progressArgs.ProgressPercentage;
  }

  void OnCompleted(object sender, RunWorkerCompletedEventArgs completedEventArgs)
  {
   _lblStatus.Text = completedEventArgs.Cancelled ? "Process: Cancelled" : "Process: Completed";
   SetButtons(true);
  }

  void OnControllerProgressChanged(object sender, TaskProgressChangedEventArgs progressArgs)
  {
   _lblStatus.Text = string.Format("{0} : {1}", progressArgs.Status, progressArgs.FileName);
   _progressBar.Value = progressArgs.ProgressPercentage;
  }

  void OnControllerTaskCompleted(object sender, AsyncCompletedEventArgs completedArgs)
  {
   _lblStatus.Text = completedArgs.Cancelled ? "Process: Cancelled" : "Process: Completed";
   SetButtons(true);
  }

  private void SetButtons(bool isCompleted)
  {
   _btnCancel.Enabled = !isCompleted;
   _btnStart.Enabled = isCompleted;
   _ckUseController.Enabled = isCompleted;
  }

  public void TraceThread()
  {
   Trace.WriteLine(Thread.CurrentThread.ManagedThreadId);
  }

  void OnCancel(object sender, EventArgs e)
  {
   if (_ckUseController.Checked)
    _controller.Stop();
   else
    _backgroundWorker.CancelAsync();

   SetButtons(true);   
  }

  void OnStart(object sender, EventArgs e)
  {
   if (_ckUseController.Checked)
    _controller.Start("empty");
   else
    _backgroundWorker.RunWorkerAsync(100);

   _lblStatus.Text = "Status: In Progress";
   SetButtons(false);
  }

 }
}

Some of the useful links from MSDN:

http://msdn.microsoft.com/en-us/library/hkasytyf.aspx

http://msdn.microsoft.com/en-us/library/2e08f6yc.aspx

WCF Configuration Schema

Difference between IServiceBehavior and IEndpointBehavior

I believe this could sound silly, but for those who are fairly new to WCF definitely would like know. By looking at the interface names, we can say that one is for extending the "Service" and the other is for extending "Endpoints". We have recently done couple of interesting things in our organization and thought would share this information with you guys.

The ApplyDispatchBehavior method on IServiceBehavior has access to all endpoints and their runtime components and so shouldn't that be enough for wiring up customization? The short answer is yes, but there are subtle differences.

Some usability differences are:

• ServiceBehavior applies only on a Service while EndpointBehavior applies on both client and service.


• ServiceBehavior can be specified via Attributes/Code/Config file while Endpointbehavior can be specified through Code or Config file.


• ServiceBehavior has access to all ServiceEndpoints dispatch runtime and so could modify all dispatch runtimes while EndpointBehavior gets called with the runtime for that endpoint only.

Look at it this way, ServiceBehavior lets you access runtime parameters for all endpoints while EndpointBehavior lets you access runtime components only for that endpoint. So if you have a need to extend functionality that spawns the entire contract (or multiple contracts) then use ServiceBehavior and if you are interested in extending one specific endpoint then use EndpointBehavior.

And of course, the biggest difference is if you want to customize endpoints on client/consumer then the only option is IEndpointBehavior.

Get Ready for Delphi RAD Studio 2010

New features include:

IDE Insight – a timesaving tool to easily find files, components, features and settings using simple keystrokes and search terms

Code Formatter – to implement consistent coding styles with minimal effort

Class Explorer – for a configurable hierarchical view of class libraries throughout a project and enabling fast navigation to declarations and implementations and now available for C++Builder

Data Visualizers – that make debugging easier by displaying visual representations of data in definable forms

Debugger Thread Control – to freeze, thaw and isolate individual threads within applications during debugging to track down problems faster

What is LINQ?

LINQ stands for Language-Integrated Query is a set of features in Visual Studio 2008 (code name "Orcas") that extends powerful query capabilities to the language syntax of C# and Visual Basic. Microsoft previous efforts (Windows Communication Foundation WCF, Windows Workflow Foundation WWF, Windows Presentation Foundation WPF, Windows CardSpace and LINQ) are integrated in this Studio. LINQ introduces standard, easily-learned patterns for querying and updating data, and the technology can be extended to support potentially any kind of data store. Visual Studio 2008 includes LINQ provider assemblies that enable the use of LINQ with .NET Framework collections, SQL Server databases, ADO.NET Datasets, and XML documents.

From past one and half years Anders Hejlsberg team has done a wonderful job in overcoming the gap between the data impedance. Mr. Anders team gives a native syntax to developers in the form LINQ to C# and VB.Net for accessing data from any repository. The repository could be in memory object, database (still MS SQL Server only) and XML files.

What is LINQ?
Basically LINQ address the current database development model in the context of Object Oriented Programming Model. If some one wants to develop database application on .Net platform the very simple approach he uses ADO.Net. ADO.Net is serving as middle ware in application and provides complete object oriented wrapper around the database SQL. Developing application in C# and VB.Net so developer must have good knowledge of object oriented concept as well as SQL, so it means developer must be familiar with both technologies to develop an application. If here I can say SQL statements are become part of the C# and VB.Net code so it’s not mistaken in form of LINQ. According to Anders Hejlsberg the chief architect of C#.

Some of the examples are:

Select:
This sample code prints a sequence of integers one greater than those in an input array. The sample uses the expression in the select clause to add one to each element in the new sequence.

public void Linq6() 
{
    int[] numbers = { 5, 4, 1, 3, 9, 8, 6, 7, 2, 0 };
    var numsPlusOne = from n in numbers select n + 1;
    
    Console.WriteLine("Numbers + 1:");
    foreach (var i in numsPlusOne) 
    {
        Console.WriteLine(i);
    }
}

Result:

Numbers + 1:
6
5
2
4
10
9
7
8
3
1

Where
This sample prints each element of an input integer array whose value is less than 5. The sample uses a query expression to create a new sequence of integers and then iterates over each element in the sequence, printing its value.

 
public void Linq1() 
{
    int[] numbers = { 5, 4, 1, 3, 9, 8, 6, 7, 2, 0 };

    var lowNums =
        from n in numbers
        where n < 5
        select n;

    Console.WriteLine("Numbers < 5:");
    foreach (var x in lowNums) 
    {
        Console.WriteLine(x);
    }
}

Result:

Numbers < 5:
4
1
3
2
0

OrderBy

This sample prints an alphabetically sorted version of an input string array. The sample uses orderby to perform the sort.

public void Linq28() 
{
    string[] words = { "cherry", "apple", "blueberry" };
    
    var sortedWords =
        from w in words
        orderby w
        select w;
    
    Console.WriteLine("The sorted list of words:");
    foreach (var w in sortedWords) 
    {
        Console.WriteLine(w);
    }
}

Result:
The sorted list of words:
apple
blueberry
cherry

There are 101 sample snippets available on MSDN.

Consuming ASP.NET 2.0 Web Services in Delphi for Win32

This is a very good article by Dr.Bob. Please read it whenever you find some time, it really helps! Thanks so much to Dr.Bob.

Difference between two different time stamps

Today I had a cute requirement which is pretty small. The user want to
see the time difference between two different time stamps.Steps to do
this1) Create a column Date1 of DateTime2) Create a column Date2 of
DateTime3) Create another column of Datatype Calculated type.then enter
the following formula in that column settings =TEXT([DATE2]-[DATE1],"H:MM").
then you are done

--
Posted By "Murali Krishna" (muki) to Delphi Tips & Tricks on 6/10/2008 03:55:00 AM

Delphi 7 is now compatible with Vista

Delphi 7 is now compatible with Vista, or Vista is now compatible with Delphi 7... anyway you look at it, I find this amusing.

Read it on marco's tech world.

Managing NT Services from Delphi

{-------------------------------------------------------------------------------------
 Unit:      uServiceManager.pas
 Purpose:   Wrapper around some of the Windows API Functions supporting NT-Services.
            The following class TServiceManager can be used to manage your NT-Services.
            You can do things like start, stop, pause or querying a services status.
 Author:    Kiran Kurapaty.
 Copyright: Kurapaty Solutions
 Dated:     18th September, 2003 at 19.10 hours IST.
 Email Id:  kiran@kurapaty.co.uk / kiran.delphi@gmail.com    
 -------------------------------------------------------------------------------------}

unit uServiceManager;

interface 

uses 
  SysUtils, Windows, WinSvc; 

type

  TServiceManager = class 
  private 
    { Private declarations } 
    ServiceControlManager: SC_Handle; 
    ServiceHandle: SC_Handle;
    fServiceName: String;
  protected 
    function DoStartService(NumberOfArgument: DWORD; ServiceArgVectors: PChar): Boolean; 
  public 
    { Public declarations } 
    destructor Destroy; override;
    function Connect(MachineName: PChar = nil; DatabaseName: PChar = nil;
      Access: DWORD = SC_MANAGER_ALL_ACCESS): Boolean;  // Access may be SC_MANAGER_ALL_ACCESS 
    function OpenServiceConnection(aServiceName: PChar): Boolean;
    function StartService: Boolean; overload; // Simple start
    function StartService(NumberOfArgument: DWORD; ServiceArgVectors: PChar): Boolean; overload; // More complex start
    function StopService: Boolean;
    function PauseService: Boolean;
    function ContinueService: Boolean;
    function ShutdownService: Boolean;
    function DisableService: Boolean;
    function GetStatus: DWORD;
    function IsServiceRunning: Boolean;
    function IsServiceStopped: Boolean;
  published
    property ServiceName : String   read fServiceName write fServiceName;
  end;

implementation 

{ TServiceManager } 

function TServiceManager.Connect(MachineName, DatabaseName: PChar; Access: DWORD): Boolean; 
begin 
  { open a connection to the windows service manager }
  ServiceControlManager := OpenSCManager(MachineName, DatabaseName, Access);
  Result := (ServiceControlManager <> 0); 
end; 


function TServiceManager.OpenServiceConnection(aServiceName: PChar): Boolean;
begin
  { open a connetcion to a specific service }
  fServiceName := aServiceName;
  ServiceHandle := OpenService(ServiceControlManager, aServiceName, SERVICE_ALL_ACCESS);
  Result := (ServiceHandle <> 0);
end;

function TServiceManager.PauseService: Boolean;
var
  ServiceStatus: TServiceStatus; 
begin 
  { Pause the service: attention not supported by all services } 
  Result := ControlService(ServiceHandle, SERVICE_CONTROL_PAUSE, ServiceStatus);
end; 

function TServiceManager.StopService: Boolean; 
var 
  ServiceStatus: TServiceStatus; 
begin 
  { Stop the service } 
  Result := ControlService(ServiceHandle, SERVICE_CONTROL_STOP, ServiceStatus);
end; 

function TServiceManager.ContinueService: Boolean;
var 
  ServiceStatus: TServiceStatus; 
begin 
  { Continue the service after a pause: attention not supported by all services }
  Result := ControlService(ServiceHandle, SERVICE_CONTROL_CONTINUE, ServiceStatus);
end; 

function TServiceManager.ShutdownService: Boolean;
var 
  ServiceStatus: TServiceStatus; 
begin 
  { Shut service down: attention not supported by all services }
  Result := ControlService(ServiceHandle, SERVICE_CONTROL_SHUTDOWN, ServiceStatus);
end; 

function TServiceManager.StartService: Boolean; 
begin 
  Result := DoStartService(0, ''); 
end; 

function TServiceManager.StartService(NumberOfArgument: DWORD; ServiceArgVectors: PChar): Boolean; 
begin 
  Result := DoStartService(NumberOfArgument, ServiceArgVectors); 
end; 

function TServiceManager.GetStatus: DWORD; 
var 
  ServiceStatus: TServiceStatus; 
begin 
{ Returns the status of the service. Maybe you want to check this 
  more than once, so just call this function again. 
  Results may be: SERVICE_STOPPED 
                  SERVICE_START_PENDING 
                  SERVICE_STOP_PENDING 
                  SERVICE_RUNNING 
                  SERVICE_CONTINUE_PENDING 
                  SERVICE_PAUSE_PENDING 
                  SERVICE_PAUSED   } 
  QueryServiceStatus(ServiceHandle, ServiceStatus);
  Result := ServiceStatus.dwCurrentState; 
end; 

function TServiceManager.DisableService: Boolean;
begin
  { Need to Implement... }
  Result := False;
end; 

function TServiceManager.IsServiceRunning: Boolean;
begin
  Result := (GetStatus = SERVICE_RUNNING);
end;

function TServiceManager.IsServiceStopped: Boolean; 
begin 
  Result := (GetStatus = SERVICE_STOPPED); 
end; 

function TServiceManager.DoStartService(NumberOfArgument: DWORD; 
  ServiceArgVectors: PChar): Boolean; 
begin
  Result := WinSvc.StartService(ServiceHandle, NumberOfArgument, ServiceArgVectors); 
end;

destructor TServiceManager.Destroy;
begin
   if (ServiceHandle <> 0) then
       CloseServiceHandle(ServiceHandle);
  inherited;
end;

end.

WOL - Wake up On LAN - How to set it up

Adding CheckBox to a TShellTreeView

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ShellCtrls,
  ComCtrls;

type
  TCheckBoxShellTreeView = class(TShellTreeView)
  public
    procedure CreateParams(var Params: TCreateParams); override;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FShellTreeView: TCheckBoxShellTreeView;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  TVS_CHECKBOXES = $00000100;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
  FShellTreeView := TCheckBoxShellTreeView.Create(Self);
  with FShellTreeView do
  begin
    Name := 'FShellTreeView';
    Parent := Self;
    Root := 'rfDesktop';
    UseShellImages := True;
    Align := alClient;
    AutoRefresh := False;
    BorderStyle := bsNone;
    Indent := 19;
    ParentColor := False;
    RightClickSelect := True;
    ShowRoot := False;
    TabOrder := 0;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FShellTreeView.Free;
end;

end.

WNet Enum Class

WNetEnumClass. This class implements the discovery of connected computers, drives, and printers, using the WNet functions.

TODO: Add an array of all TNetResources, and functions to allow their access from the calling app. Or more properly, functions that will return useful info from the TNetResources, simplifying the determination of device type, and so on.

USAGE:

 var
    Obj :TWNetEnumClass;
 begin
    Obj := TWNetEnumClass.Create(Self);
    try
      Obj.Refresh;
      Memo1.Lines := Obj.GetAllNames;
      Memo2.Lines := Obj.GetCompNames;
      Memo3.Lines := Obj.GetDiskNames;
      Memo4.Lines := Obj.GetDomainNames;
      Memo5.Lines := Obj.GetErrors;
      Memo6.Lines := Obj.GetPrintNames;
    finally
      Obj.Free;
    end;
  end;

unit uWNetEnumClass;

interface

uses
  Classes, Sysutils, Windows;

type
  TWNetEnumClass = class(TObject)
  private
    FslAllNames: TStringList;
    FslCompNames: TStringList;
    FslDiskNames: TStringList;
    FslDomainNames: TStringList;
    FslErrors: TStringList;
    FslPrintNames: TStringList;
    procedure ErrorHandler(errorNum: Cardinal; s: string);
    function EnumerateResources(startingPoint: TNetResource): Boolean;
  protected
    procedure EnumResources;
  public
    constructor Create(Owner: TComponent); virtual;
    destructor Destroys; virtual;

    function GetAllNames: TStringList;
    function GetCompNames: TStringList;
    function GetDiskNames: TStringList;
    function GetDomainNames: TStringList;
    function GetErrors: TStringList;
    function GetPrintNames: TStringList;

    procedure Refresh; // used by calling apps to populate the lists
  end;

implementation

{ TWNetEnumClass }

const
  BASE_RES = 128;
  MAX_RES = 8192;

var
  // establish a buffer to use to prime the drill-down process
  base_buffer: array of TNetResource;

constructor TWNetEnumClass.Create(Owner: TComponent);
begin
  inherited Create;

  SetLength(base_buffer, BASE_RES); // initialize the base buffer

  // now create the stringlists we will use
  FslAllNames := TStringList.Create;
  FslCompNames := TStringList.Create;
  FslDiskNames := TStringList.Create;
  FslDomainNames := TStringList.Create;
  FslErrors := TStringList.Create;
  FslPrintNames := TStringList.Create;
end;

destructor TWNetEnumClass.Destroys;
begin
  // free the stringlists
  FslPrintNames.Free;
  FslErrors.Free;
  FslDomainNames.Free;
  FslDiskNames.Free;
  FslCompNames.Free;
  FslAllNames.Free;

  base_buffer := nil; // free the base buffer

  inherited Destroy;
end;

//

function TWNetEnumClass.EnumerateResources(startingPoint: TNetResource): Boolean;
var
  res: Cardinal;
  resEnum: Cardinal;
  enumHandle: THandle;
  buffer: array of TNetResource;
  bufferSize: Cardinal;
  numEntries: Cardinal;
  i: Cardinal;
begin // EnumerateResources
  // Open a container
  res := WNetOpenEnum(
    RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @startingPoint, enumHandle);
  if (res <> NO_ERROR) then
    ErrorHandler(res, 'WNetOpenEnum');

  // loop through all the elements in the container
  repeat
    numEntries := Cardinal(-1);
    SetLength(buffer, MAX_RES);
    bufferSize := SizeOf(TNetResource) * MAX_RES;

    // get resources
    resEnum := WNetEnumResource(enumHandle, numEntries, buffer, bufferSize);
    if (resEnum = NO_ERROR) then
    begin
      // loop through all entries
      for i := 0 to numEntries - 1 do
      begin
        if (buffer[i].dwDisplayType = RESOURCEDISPLAYTYPE_SERVER) then
          FslCompNames.Add(buffer[i].lpRemoteName)
        else if (buffer[i].dwType = RESOURCETYPE_PRINT) then
          FslPrintNames.Add(buffer[i].lpRemoteName)
        else if (buffer[i].dwType = RESOURCETYPE_DISK) then
          FslDiskNames.Add(buffer[i].lpRemoteName)
        else if (buffer[i].dwDisplayType = RESOURCEDISPLAYTYPE_DOMAIN) then
          FslDomainNames.Add(buffer[i].lpRemoteName);
        // if the entry is a container, recursively open it
        if (buffer[i].dwUsage and RESOURCEUSAGE_CONTAINER > 0) then
          if (not EnumerateResources(buffer[i])) then
            FslErrors.Add('Enumeration failed');
      end;
    end
    else if (resEnum <> ERROR_NO_MORE_ITEMS) then
      ErrorHandler(resEnum, 'WNetEnumResource');
    { added the test for ERROR_INVALID_HANDLE to deal with the case where a "remembered"
      connection is no longer in existence. I need to look for a cleaner fix. }
  until (resEnum = ERROR_NO_MORE_ITEMS) or (resEnum = ERROR_INVALID_HANDLE);

  // clean up
  buffer := nil;
  res := WNetCloseEnum(enumHandle);
  if (res <> NO_ERROR) then
  begin
    ErrorHandler(res, 'WNetCloseEnum');
    result := False;
  end
  else
    result := True;
end;

procedure TWNetEnumClass.EnumResources;
begin
  EnumerateResources(base_buffer[0]);
end;

procedure TWNetEnumClass.ErrorHandler(errorNum: Cardinal; s: string);
var
  res: Cardinal;
  error: Cardinal;
  errorStr: string;
  nameStr: string;
begin
  if (errorNum <> ERROR_EXTENDED_ERROR) then
  begin
    FslErrors.Add('Error number ' + IntToStr(errorNum) + ' returned by ' + s);
  end
  else
  begin
    res := WNetGetLastError(
      error, PChar(errorStr), 1000, PChar(nameStr), 1000);
    if (res <> NO_ERROR) then
      FslErrors.Add('Failure in WNetGetLastError: ' + IntToStr(error))
    else
    begin
      FslErrors.Add('Extended Error: ' + errorStr + '. Provider: ' + nameStr);
    end;
  end;
end;

function TWNetEnumClass.GetAllNames: TStringList;
begin
  FslAllNames.Sort;
  Result := FslAllNames;
end;

function TWNetEnumClass.GetCompNames: TStringList;
begin
  FslCompNames.Sort;
  Result := FslCompNames;
end;

function TWNetEnumClass.GetDiskNames: TStringList;
begin
  FslDiskNames.Sort;
  Result := FslDiskNames;
end;

function TWNetEnumClass.GetDomainNames: TStringList;
begin
  FslDomainNames.Sort;
  Result := FslDomainNames;
end;

function TWNetEnumClass.GetErrors: TStringList;
begin
  Result := FslErrors;
end;

function TWNetEnumClass.GetPrintNames: TStringList;
begin
  FslPrintNames.Sort;
  Result := FslPrintNames;
end;

procedure TWNetEnumClass.Refresh;
begin
  FslAllNames.Clear;
  FslCompNames.Clear;
  FslDiskNames.Clear;
  FslDomainNames.Clear;
  FslErrors.Clear;
  FslPrintNames.Clear;
  EnumResources;
end;

end.