Tuesday, August 19, 2008

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.

Monday, August 18, 2008

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.

Friday, June 13, 2008

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

Thursday, May 29, 2008

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.

Friday, February 15, 2008

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.

Wednesday, January 30, 2008

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.

Creating Excel (XLS) from Delphi


const
CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0);
CXlsEof: array[0..1] of Word = ($0A, 00);
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);

procedure XlsBeginStream(XlsStream: TStream; const BuildNumber: Word);
begin
CXlsBof[4] := BuildNumber;
XlsStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;

procedure XlsEndStream(XlsStream: TStream);
begin
XlsStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;

procedure XlsWriteCellRk(XlsStream: TStream; const ACol, ARow: Word; const AValue: Integer);
var
V: Integer;
begin
CXlsRk[2] := ARow;
CXlsRk[3] := ACol;
XlsStream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
V := (AValue shl 2) or 2;
XlsStream.WriteBuffer(V, 4);
end;

procedure XlsWriteCellNumber(XlsStream: TStream; const ACol, ARow: Word; const AValue: Double);
begin
CXlsNumber[2] := ARow;
CXlsNumber[3] := ACol;
XlsStream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
XlsStream.WriteBuffer(AValue, 8);
end;

procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word; const AValue: string);
var
L: Word;
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := ARow;
CXlsLabel[3] := ACol;
CXlsLabel[5] := L;
XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
FStream: TFileStream;
I, J: Integer;
begin
FStream := TFileStream.Create('J:\e.xls', fmCreate);
try
XlsBeginStream(FStream, 0);
for I := 0 to 99 do
for J := 0 to 99 do
begin
XlsWriteCellNumber(FStream, I, J, 34.34);
// XlsWriteCellRk(FStream, I, J, 3434);
// XlsWriteCellLabel(FStream, I, J, Format('Cell: %d,%d', [I, J]));
end;
XlsEndStream(FStream);
finally
FStream.Free;
end;
end;

Paint Dock Frame


procedure TDockTree.PaintDockFrame(Canvas: TCanvas; Control: TControl; const ARect: TRect);

procedure DrawCloseButton(Left, Top: Integer);
begin
DrawFrameControl(Canvas.Handle, Rect(Left, Top, Left+FGrabberSize-2,
Top+FGrabberSize-2), DFC_CAPTION, DFCS_CAPTIONCLOSE);
end;

procedure DrawGrabberLine(Left, Top, Right, Bottom: Integer);
begin
with Canvas do
begin
Pen.Color := clBtnHighlight;
MoveTo(Right, Top);
LineTo(Left, Top);
LineTo(Left, Bottom);
Pen.Color := clBtnShadow;
LineTo(Right, Bottom);
LineTo(Right, Top-1);
end;
end;

begin
with ARect do
if FDockSite.Align in [alTop, alBottom] then
begin
DrawCloseButton(Left+1, Top+1);
DrawGrabberLine(Left+3, Top+FGrabberSize+1, Left+5, Bottom-2);
DrawGrabberLine(Left+6, Top+FGrabberSize+1, Left+8, Bottom-2);
end
else
begin
DrawCloseButton(Right-FGrabberSize+1, Top+1);
DrawGrabberLine(Left+2, Top+3, Right-FGrabberSize-2, Top+5);
DrawGrabberLine(Left+2, Top+6, Right-FGrabberSize-2, Top+8);
end;
end;

Convert Shockwave SWF to EXE

Example:
 
Swf2Exe('C:\somefile.swf', 'C:\somefile.exe', 'C:\Program Files\MacromediaFlash MX\Players\SAFlashPlayer.exe');



function Swf2Exe(SourceSWF, exeFile, FlashPlayer : string): string;
var
SourceStream, DestinyStream, LinkStream : TFileStream;
flag : Cardinal;
SwfFileSize : integer;
begin
result := 'Error';
DestinyStream := TFileStream.Create(exeFile, fmCreate);
try
LinkStream := TFileStream.Create(FlashPlayer, fmOpenRead or fmShareExclusive);
try
DestinyStream.CopyFrom(LinkStream, 0);
finally
LinkStream.Free;
end;

SourceStream := TFileStream.Create(SourceSWF, fmOpenRead or fmShareExclusive);
try
DestinyStream.CopyFrom(SourceStream, 0);
flag := $FA123456;
DestinyStream.WriteBuffer(flag, sizeof(integer));
SwfFileSize := SourceStream.Size;
DestinyStream.WriteBuffer(SwfFileSize, sizeof(integer));
result := '';
finally
SourceStream.Free;
end;
finally
DestinyStream.Free;
end;
end;

Customise your Message Dialog


procedure TForm1.Button2Click(Sender: TObject);
var
Dlg: TForm;
Rslt: Integer;
begin
Dlg := CreateMessageDialog('Customised MessageBox, hope this is helpful', mtConfirmation, [mbYes, mbNo, mbNoToAll]);

{ change the messagedlg caption }
Dlg.Caption := 'Please Confirm';

{change the button texts }
TButton(Dlg.FindComponent('Yes')).Caption := 'Indeed!';
TButton(Dlg.FindComponent('No')).Caption := 'Surely Not!';
TButton(Dlg.FindComponent('NoToAll')).Caption := 'None please!';

{ change the button fonts }
TButton(Dlg.FindComponent('Yes')).Font.Name := 'C4 Text';
TButton(Dlg.FindComponent('No')).Font.Name := 'C4 TextMedium' ;
TButton(Dlg.FindComponent('NoToAll')).Font.Name := 'Tahoma';
//this sets the buttons font to Bold & Underlined
TButton(Dlg.FindComponent('NoToAll')).Font.Style:=[fsBold];

{ change the Message's appearance }
TLabel(Dlg.FindComponent('Message')).Font.Name := 'Courier New';
TLabel(Dlg.FindComponent('Message')).Font.Size := 12;
TLabel(Dlg.FindComponent('Message')).Font.Color := clRed;

Rslt := Dlg.ShowModal;

case Rslt of
mrYes: { do "Yes" stuff };
mrNo: { do "No" stuff };
mrNoToAll: { do "No to All" stuff };
end;
end;

Calculate estimated Download time of a File


{ Add this under your type declaration }

type
TDRec = record
H, M, S: Integer;
end;

const
Count = 6;
BpsArray: array [0..Count] of Integer = (14400, 28800, 33600, 56000, 64000, 128000, 512000);

function CalculateDLTime(const Value, Units, Connection: Integer): TDRec;
var
i, size_bits, filedltimesec, hourmod, HH, MM, SS: Integer;
Rec: TDRec;

function pow(a, b: Integer): Integer;
function sl(nr, times: Integer): Integer;
var
i: Integer;
begin
Result := nr * nr;
for i := 0 to times do Result := Result + nr * nr;
end;
begin
if a > b then
Result := sl(a, b)
else
Result := sl(b, a);
end;
begin
case Units of
1: size_bits := (8 div 1) * Value; // bytes
2: size_bits := (8 div 1) * ((pow(2,10)) div 1) * Value; // kilobytes
3: size_bits := (8 div 1) * ((pow(2,20)) div 1) * Value; // Megabytes
end;

// Calculate
filedltimesec := Round(size_bits) div BpsArray[Connection];

hourmod := filedltimesec mod (60 * 60); // Modulus.
HH := Floor(filedltimesec / (60 * 60));
MM := Floor(hourmod / 60);
SS := Floor(filedltimesec mod 60); // Modulus.

if SS > 0 then Inc(SS);

with Rec do
begin
H := HH;
M := MM;
S := SS;
end;

Result := Rec;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
Rec: TDRec;
begin
ListView1.Items.Clear;

for i := 0 to Count do
begin
Rec := CalculateDLTime(StrToInt(Edit1.Text), ComboBox1.ItemIndex + 1,i);

with ListView1.Items.Add do
begin
Caption := NameArray[i];
SubItems.Add(IntToStr(Rec.H));
SubItems.Add(IntToStr(Rec.M));
SubItems.Add(IntToStr(Rec.S));
end;
end;
end;

Thursday, October 25, 2007

CRC Check / CRC Values

CRC values are calculated using an algorithm known as the Cyclic Redundancy Check, or "CRC" for short. Basically, this involves generating a 32-bit number (or "CRC value") based on the contents of a file. If the contents of a file change, its CRC value changes as well. This allows the CRC number to be used as a "checksum" in order to identify whether or not the file has changed. It also allows you to distinguish between different versions of a file by comparing its CRC value to the CRC values of the originals.

The basic idea of the CRC algorithm is to treat all the bits in a file as one big binary number, and then divide that number by a standard value. The remainder from the division is the CRC value.

You can think of this value as being like a fingerprint for each file. Unlike human fingerprints, however, it isn't impossible for two files to have the same CRC-32 value. UpdatesDownloader uses an industry-standard CRC-32 algorithm which generates CRC values that are 32 bits in length. This means that one in every 4,294,967,296 files could have the same CRC "fingerprint."

A file doesn't have to change much for its CRC value to be different. In fact, if even just one bit in a file changes, the CRC value for that file will change as well. If all you did was change one letter in a readme.txt file between version 1 and version 2, the CRC value for that readme.txt file would be completely different.

CRC values can be calculated for any type of file.

Although the chances of any two files having the same CRC value are incredibly small, the CRC value alone isn't enough to guarantee an accurate identification. If you need to be absolutely sure, check the CRC in addition to other information about the file, such as the size of the file in bytes and its location on the user's system.

Thursday, August 30, 2007

Sending an email using MAPI

There are lot of different methods to send mail using MAPI (Windows Simple Mail API)
If you do not want to rely on Outlook to send an email but you know that MAPI is installed, then you can also send mails with the following handy routine SendMailMAPI(). You need to add unit MAPI to your uses clause. Note that MAPI is not always installed with Windows.

unit uMAPIMail;

interface

uses MAPI;

function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail,
RecepientName, RecepientEMail: String) : Integer;

implementation

function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail,
RecepientName, RecepientEMail: String) : Integer;
var
message: TMapiMessage;
lpSender,
lpRecepient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
SM: TFNMapiSendMail;
MAPIModule: HModule;
begin
FillChar(message, SizeOf(message), 0);
with message do
begin
if (Subject<>'') then
begin
lpszSubject := PChar(Subject)
end;
if (Body<>'') then
begin
lpszNoteText := PChar(Body)
end;
if (SenderEMail<>'') then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if (SenderName='') then
begin
lpSender.lpszName := PChar(SenderEMail)
end
else
begin
lpSender.lpszName := PChar(SenderName)
end;
lpSender.lpszAddress := PChar('SMTP:'+SenderEMail);
lpSender.ulReserved := 0;
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := @lpSender;
end;
if (RecepientEMail<>'') then
begin
lpRecepient.ulRecipClass := MAPI_TO;
if (RecepientName='') then
begin
lpRecepient.lpszName := PChar(RecepientEMail)
end
else
begin
lpRecepient.lpszName := PChar(RecepientName)
end;
lpRecepient.lpszAddress := PChar('SMTP:'+RecepientEMail);
lpRecepient.ulReserved := 0;
lpRecepient.ulEIDSize := 0;
lpRecepient.lpEntryID := nil;
nRecipCount := 1;
lpRecips := @lpRecepient;
end
else
begin
lpRecips := nil
end;
if (FileName='') then
begin
nFileCount := 0;
lpFiles := nil;
end
else
begin
FillChar(FileAttach, SizeOf(FileAttach), 0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(FileName);
nFileCount := 1;
lpFiles := @FileAttach;
end;
end;
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule=0 then
begin
Result := -1
end else
begin
try
@SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if @SM<>nil then
begin
Result := SM(0, Application.Handle, message, MAPI_DIALOG or MAPI_LOGON_UI,0);
end else
begin
Result := 1
end;

finally
FreeLibrary(MAPIModule);
end;
end
if Result<>0 then
begin
MessageDlg('Error sending mail ('+IntToStr(Result)+').', mtError, [mbOk], 0)
end;
end;

end.

Monday, August 20, 2007

Preventing second instance of the application

There are many ways, but we'll see couple of examples here...

a) Using "GlobalAddAtom" & "GlobalFindAtom" API calls

 
procedure TForm1.FormCreate(Sender: TObject);
begin
{Searchs table to see if the program is already running}
if GlobalFindAtom('PROGRAM_RUNNING') = 0 then
{ If not found then add it }
atom := GlobalAddAtom('PROGRAM_RUNNING')
else begin
{ If program is already running the show message and halt }
MessageDlg('You have the program running all ready!!', mtWarning, [mbOK], 0);
Halt;
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{Removes the item from the table so it can be run again}
GlobalDeleteAtom(atom);
end;



b) Using "CreateMutex" & "OpenMutex" you can control this from your *.dpr code itself. Here we will try to create the mutex (kernel) object on the OS when your application starts for the first time.
ex:
MutexHandle := CreateMutex(Nil, False, 'ANYTHING-WHICH-IS-UNIQUE-TO-UR-APP');
if MutexHandle returns zero(0) or some error, that means the mutex is already created and your application is running in the background. Here you can just quit the application or you throw some error message to the user, using the below code...

MutexHandle := OpenMutex(MUTEX_ALL_ACCESS, False, 'ANYTHING-WHICH-IS-UNIQUE-TO-UR-APP');

If MutexHandle retruns zero (0) or some error, then there is some problem with your kernel object just exit from there, otherwise you can show the error message like I have shown in the above example and quit from the application.
Finally, dont forget to free the MutexHandle. You will get more information when you search for "CreateMutex" "OpenMutex" in Google.com

c) Using "CreateFileMapping" / "MapViewOfFile" / "UnmapViewOfFile", its bit complex to understand, but if you are familiar with Windows API calls then it would probably help you.

Sunday, July 29, 2007

Sending Mail using Thread


unit uSMTPMailer;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Dialogs, IdMessage, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdMessageClient, IdSMTP, StdCtrls;

type
TSendMail = class(TThread)
private
FPortNumber: Integer;
FSubject: String;
FPassword: String;
FServerName: String;
FFromAddress: String;
FBodyMessage: TStrings;
FRecipientsList: TStrings;
procedure SetBodyMessage(const Value: TStrings);
procedure SetFromAddress(const Value: String);
procedure SetPasword(const Value: String);
procedure SetPortNumber(const Value: Integer);
procedure SetRecipientsList(const Value: TStrings);
procedure SetServerName(const Value: String);
procedure SetSubject(const Value: String);
public
constructor Create(ASuspended: Boolean);
property PortNumber: Integer read FPortNumber write SetPortNumber;
property ServerName: String read FServerName write SetServerName;
property Password: String read FPassword write SetPasword;
property FromAddress: String read FFromAddress write SetFromAddress;
property Recipients: TStrings read FRecipientsList write SetRecipientsList;
property Subject: String read FSubject write SetSubject;
property Body: TStrings read FBodyMessage write SetBodyMessage;
procedure SendEMail;
protected
procedure Execute; override;
end;

function SendSMTPMail(APort: Integer;
ASMTPServer, APassword, AFromAddress: String;
AToAddresses, ABodyText: TStrings): Boolean;

implementation

{ TSendMail }
constructor TSendMail.Create(ASuspended: Boolean);
begin
inherited Create(ASuspended);
FreeOnTerminate := True;
FBodyMessage := TStringList.Create;
FRecipientsList := TStringList.Create;
end;

procedure TSendMail.Execute;
var
FIdSMTP: TIdSMTP;
FIdMessage: TIdMessage;
begin
FIdSMTP := TIdSMTP.Create(nil);
FIdMessage := TIdMessage.Create(nil);
try
FIdSMTP.Host := FServerName;
FIdSMTP.Port := FPortNumber;
FIdSMTP.Password:= FPassword;
FIdMessage.From.Address := FFromAddress;
FIdmessage.Recipients.Assign(FRecipientsList);
FIdMessage.Subject := FSubject;
FIdMessage.Body.Assign(FBodyMessage);
try
FIdSMTP.Connect;
FIdSMTP.Send(FIdMessage);
except end;
finally
if FIdSMTP.Connected then FIdSMTP.Disconnect;
FreeAndNil(FIdMessage);
FreeAndNil(FIdSMTP);
end;
end;

procedure TSendMail.SendEMail;
begin
Resume;
end;

procedure TSendMail.SetBodyMessage(const Value: TStrings);
begin
FBodyMessage.Assign(Value);
end;

procedure TSendMail.SetFromAddress(const Value: String);
begin
FFromAddress := Value;
end;

procedure TSendMail.SetPasword(const Value: String);
begin
FPassword := Value;
end;

procedure TSendMail.SetPortNumber(const Value: Integer);
begin
FPortNumber := Value;
end;

procedure TSendMail.SetRecipientsList(const Value: TStrings);
begin
FRecipientsList.Assign(Value);
end;

procedure TSendMail.SetServerName(const Value: String);
begin
FServerName := Value;
end;

procedure TSendMail.SetSubject(const Value: String);
begin
FSubject := Value;
end;

function SendSMTPMail(APort: Integer; ASMTPServer, APassword,
AFromAddress: String; AToAddresses, ABodyText: TStrings): Boolean;
begin
try
with TSendMail.Create(True) do
begin
PortNumber := APort;
ServerName := ASMTPServer;
Password := APassword;
FromAddress := AFromAddress;
Recipients.Assign(AToAddresses);
Body.Assign(ABodyText);
SendEMail;
{no need to free, its a self destructive thread}
end;
Result := True;
except
Result := False;
end;
end;

end.

Thursday, July 26, 2007

Display a shaded column like Windows Explorer in XP

The Windows Explorer in XP displays the sorted column in pale grey. We can bring up similar behaviour in Delphi TListView by handling all two OnCustomDraw, OnColumnClick events to display a list view with a specified column shaded in pale grey.


procedure TForm1.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
FColumnToSort := Column.Index;
ListView1.Invalidate;
end;

procedure TForm1.ListView1CustomDraw(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean);
var
ColLeft: Integer;
ColBounds: TRect;
I: Integer;
begin
ColLeft := ARect.Left;
for I := 0 to Pred(FColumnToSort) do
ColLeft := ColLeft + ListView_GetColumnWidth(ListView1.Handle, I);

ColBounds := Rect(ColLeft, ARect.Top, ColLeft + ListView_GetColumnWidth(ListView1.Handle, FColumnToSort), ARect.Bottom);

ListView1.Canvas.Brush.Color := clSilver;
ListView1.Canvas.FillRect(ColBounds);
end;

Monday, June 25, 2007

Calculate Size of Folders, Sub folders and files


function DirSize(const ADirName : string; ARecurseDirs : boolean = true): integer;
const
FIND_OK = 0;
var
nResult : integer;

procedure _RecursiveDir(const ADirName : string);
var
sDirName : String;
rDirInfo : TSearchRec;
nFindResult : Integer;
begin
sDirName := IncludeTrailingPathDelimiter(ADirName);
nFindResult := FindFirst(sDirName + '*.*',faAnyFile,rDirInfo);

while nFindResult = FIND_OK do
begin
// Ignore . and .. directories
if (rDirInfo.Name[1] <> '.') then
begin
if (rDirInfo.Attr and faDirectory = faDirectory) and ARecurseDirs then
RecursiveDir(sDirName + rDirInfo.Name) // Keep Recursing
else
inc(nResult, rDirInfo.Size); // Accumulate Sizes
end;

nFindResult := FindNext(rDirInfo);
if nFindResult <> FIND_OK then
FindClose(rDirInfo);
end;
end;

// DirSize Main
begin
Screen.Cursor := crHourGlass;
Application.ProcessMessages;
nResult := 0;
RecursiveDir(ADirName);
Screen.Cursor := crDefault;

Result := nResult;
end;

How to catch kernel-signals in Kylix?


program TestSignals;

{$APPTYPE CONSOLE}

uses Libc;

var
bTerminate: Boolean;

procedure SignalProc(SigNum: Integer); cdecl;
begin
case SigNum of
SIGQUIT:
begin
WriteLn('signal SIGQUIT');
bTerminate := true;
end;
SIGUSR1: WriteLn('signal SIGUSR1');
else
WriteLn('not handled signal');
end;
signal(SigNum, SignalProc);
end;

begin
bTerminate := false;

signal(SIGQUIT, SignalProc);
signal(SIGUSR1, SignalProc);

repeat
sleep(1);
until bTerminate;
end.