Kamis, 17 April 2008

How To Delete File To Recycle Bin

we can delete the file to recycle bin using shellapi function :

uses ShellAPI;


procedure TForm1.Button1Click(Sender: TObject);

var
MyFileStruct: TSHFileOpStruct;
begin
with MyFileStruct do
begin
Wnd:=Form1.Handle;
wFunc:=FO_DELETE;
pFrom:=PChar(Edit1.Text);
fFlags:=FOF_ALLOWUNDO;
end;
try
SHFileOperation(MyFileStruct);
except
on EAccessViolation do Edit1.Text:='';
end;
end;


How To Check MySQL Connection is in use by another

// ******************************************************************
// MS-SQL : CONNECTION IS IN USE BY ANOTHER STATEMENT
// Category : ADO
// Author : DelphiFAQ.com
// Author Email : tips@delphifaq.com
// Author Web : http://www.delphifaq.com
// Tips Website : Delphi FAQ
// Tips Website URL: http://www.delphifaq.com
// ******************************************************************

{
When porting a larger database application (130k LOC) that worked fine with
Oracle and InterBase to MS-SQL (6.5), I frequently got the error message
‘connection is in use by another statement’.

At first, creating a new TDatabase for each TTable/ TQuery seemed to be
necessary.

Then I found what was ‘wrong’ (not really wrong.. :-)

To speed up some of my queries, I had set the property Unidirectional to true.
Delphi creates for such queries only one cursor (versus two for bidirectional
queries or TTables). After removing the assignments of Unidirectional := true
the error message disappeared and everything worked fine.

The following code resulted in the exception ‘connection is in use by another
statement’:
}

// dataBaseNameS : string is the name of the alias (MS-SQL 6.5)
begin
Query1 := TQuery.Create (Application);
With Query1 do
begin
DatabaseName := dataBaseNameS;
SQL.Text := ‘SELECT * FROM ABLESTOP’;
// the exception disappears if the following is removed
Unidirectional := True;
Open;
end;
ShowMessage (’ok’)

Table1 := TTable.Create (Self);
With Table1 do
begin
DatabaseName := dataBaseNameS;
TableName := ‘COMPONENT_PLAN’;
UpdateMode := upWhereKeyOnly;
Open
end;

Table1.Insert;
Table1.FieldByName (’PARTNO’).AsString := IntToStr (GetTickCount);
Table1.FieldByName (’ID’).AsString := ‘WWxx’;
Table1.FieldByName (’VERSION’).AsInteger := 1;
// the exception will occurr in the next statement:
// “Connection is in use by another statement”
Table1.Post;
end;

Rabu, 16 April 2008

Write To ACCESS DataBase USING ADO / SQL

How to use TADOtable component to read and write from Access Database ?

here is the code:

// ******************************************************************
// Author : Michael Casse
// Author Email : michaelc@netspace.net.au
// Author Web :
// Tips Website : Swiss Delphi Center
// Tips Website URL: http://www.swissdelphicenter.ch
// ******************************************************************

// Read an MS-ACCESS Database using ADO
// Verify if it is an ACCESS MDB File
// Write a Record to MS-ACCESS Database
// Components Needed on the Application Form are:-
// TADOtable,TDataSource,TOpenDialog,TDBGrid,
// TBitBtn,TTimer,TEditTextBox
// Date : 22/01/2002
// Author: Michael Casse.

program ADOdemo;

uses
Forms,
uMain in ‘uMain.pas’ {frmMain};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end.
///////////////////////////////////////////////////////////////////
unit uMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables, ADODB, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Buttons,
ComObj;

type
TfrmMain = class(TForm)
DBGridUsers: TDBGrid;
BitBtnClose: TBitBtn;
DSource1: TDataSource;
EditTextBox: TEdit;
BitBtnAdd: TBitBtn;
TUsers: TADOTable;
BitBtnRefresh: TBitBtn;
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure ConnectToAccessDB(lDBPathName, lsDBPassword: string);
procedure ConnectToMSAccessDB(lsDBName, lsDBPassword: string);
procedure AddRecordToMSAccessDB;
function CheckIfAccessDB(lDBPathName: string): Boolean;
function GetDBPath(lsDBName: string): string;
procedure BitBtnAddClick(Sender: TObject);
procedure BitBtnRefreshClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
function GetADOVersion: Double;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;
Global_DBConnection_String: string;
const
ERRORMESSAGE_1 = ‘No Database Selected’;
ERRORMESSAGE_2 = ‘Invalid Access Database’;

implementation

{$R *.DFM}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
ConnectToMSAccessDB(’ADODemo.MDB’, ‘123′); // DBName,DBPassword
end;

procedure TfrmMain.ConnectToMSAccessDB(lsDBName, lsDBPassword: string);
var
lDBpathName: string;
begin
lDBpathName := GetDBPath(lsDBName);
if (Trim(lDBPathName) <> ”) then
begin
if CheckIfAccessDB(lDBPathName) then
ConnectToAccessDB(lDBPathName, lsDBPassword);
end
else
MessageDlg(ERRORMESSAGE_1, mtInformation, [mbOK], 0);
end;

function TfrmMain.GetDBPath(lsDBName: string): string;
var
lOpenDialog: TOpenDialog;
begin
lOpenDialog := TOpenDialog.Create(nil);
if FileExists(ExtractFileDir(Application.ExeName) + ‘\’ + lsDBName) then
Result := ExtractFileDir(Application.ExeName) + ‘\’ + lsDBName
else
begin
lOpenDialog.Filter := ‘MS Access DB|’ + lsDBName;
if lOpenDialog.Execute then
Result := lOpenDialog.FileName;
end;
end;

procedure TfrmMain.ConnectToAccessDB(lDBPathName, lsDBPassword: string);
begin
Global_DBConnection_String :=
‘Provider=Microsoft.Jet.OLEDB.4.0;’ +
‘Data Source=’ + lDBPathName + ‘;’ +
‘Persist Security Info=False;’ +
‘Jet OLEDB:Database Password=’ + lsDBPassword;

with TUsers do
begin
ConnectionString := Global_DBConnection_String;
TableName := ‘Users’;
Active := True;
end;
end;

// Check if it is a valid ACCESS DB File Before opening it.

function TfrmMain.CheckIfAccessDB(lDBPathName: string): Boolean;
var
UnTypedFile: file of Byte;
Buffer: array[0..19] of Byte;
NumRecsRead: Integer;
i: Integer;
MyString: string;
begin
AssignFile(UnTypedFile, lDBPathName);
reset(UnTypedFile,1);
BlockRead(UnTypedFile, Buffer, 19, NumRecsRead);
CloseFile(UnTypedFile);
for i := 1 to 19 do MyString := MyString + Trim(Chr(Ord(Buffer[i])));
Result := False;
if Mystring = ‘StandardJetDB’ then
Result := True;
if Result = False then
MessageDlg(ERRORMESSAGE_2, mtInformation, [mbOK], 0);
end;

procedure TfrmMain.BitBtnAddClick(Sender: TObject);
begin
AddRecordToMSAccessDB;
end;

procedure TfrmMain.AddRecordToMSAccessDB;
var
lADOQuery: TADOQuery;
lUniqueNumber: Integer;
begin
if Trim(EditTextBox.Text) <> ” then
begin
lADOQuery := TADOQuery.Create(nil);
with lADOQuery do
begin
ConnectionString := Global_DBConnection_String;
SQL.Text :=
‘SELECT Number from Users’;
Open;
Last;
// Generate Unique Number (AutoNumber in Access)
lUniqueNumber := 1 + StrToInt(FieldByName(’Number’).AsString);
Close;
// Insert Record into MSAccess DB using SQL
SQL.Text :=
‘INSERT INTO Users Values (’ +
IntToStr(lUniqueNumber) + ‘,’ +
QuotedStr(UpperCase(EditTextBox.Text)) + ‘,’ +
QuotedStr(IntToStr(lUniqueNumber)) + ‘)’;
ExecSQL;
Close;
// This Refreshes the Grid Automatically
Timer1.Interval := 5000;
Timer1.Enabled := True;
end;
end;
end;

procedure TfrmMain.BitBtnRefreshClick(Sender: TObject);
begin
Tusers.Active := False;
Tusers.Active := True;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
Tusers.Active := False;
Tusers.Active := True;
Timer1.Enabled := False;
end;

function TfrmMain.GetADOVersion: Double;
var
ADO: OLEVariant;
begin
try
ADO := CreateOLEObject(’adodb.connection’);
Result := StrToFloat(ADO.Version);
ADO := Null;
except
Result := 0.0;
end;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
ShowMessage(Format(’ADO Version = %n’, [GetADOVersion]));
end;

end.

How To Register ActiveX Control (OCX) From Delphi

Sometimes, when we make application that use OCX file, we must make sure that the ActiveX control is registered on our users machines.

for example when you import an ActiveX control into your project, you'll need to make sure that this ActiveX control is registered on your users machines. If the control is not registered there, an EOleSysError exception will be displayed to your user eyes.

we can use RegSvr32.exe manually (Windows.Start - Run) to register and unregister OLE controls such as dynamic link library (DLL) or ActiveX Controls (OCX) files that are self-registerable.

The regsvr32.exe command-line tool registers dll and ActiveX controls on a system. You can manually use the Regsvr32.exe (Windows.Start - Run) to register and unregister OLE controls such as dynamic link library (DLL) or ActiveX Controls (OCX) files that are self-registerable.
When you use Regsvr32.exe, it attempts to load the component and call its DLLSelfRegister function. If this attempt is successful, Regsvr32.exe displays a dialog indicating success.

the good news isbut we can import the activex control from delphi code runtime.

From Delphi Code we can do like this :

uses shellapi;
...
function ExecAndWait(const ExecuteFile, ParamString : string): boolean;
var
SEInfo: TShellExecuteInfo;
ExitCode: DWORD;
begin
FillChar(SEInfo, SizeOf(SEInfo), 0);
SEInfo.cbSize := SizeOf(TShellExecuteInfo);
with SEInfo do begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Application.Handle;
lpFile := PChar(ExecuteFile);
lpParameters := PChar(ParamString);
nShow := SW_HIDE;
end;
if ShellExecuteEx(@SEInfo) then
begin
repeat
Application.ProcessMessages;
GetExitCodeProcess(SEInfo.hProcess, ExitCode);
until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
Result:=True;
end
else Result:=False;
end;
procedure RegisterOCX;
type
TRegFunc = function : HResult; stdcall;
var
ARegFunc : TRegFunc;
aHandle : THandle;
ocxPath : string;
begin
try
ocxPath := ExtractFilePath(Application.ExeName) + 'Flash.ocx';
aHandle := LoadLibrary(PChar(ocxPath));
if aHandle <> 0 then
begin
ARegFunc := GetProcAddress(aHandle,'DllRegisterServer');
if Assigned(ARegFunc) then
begin
ExecAndWait('regsvr32','/s ' + ocxPath);
end;
FreeLibrary(aHandle);
end;
except
ShowMessage(Format('Unable to register %s', [ocxPath]));
end;
end;