2007. június 11., hétfő
Find a word in an Array of String
Problem/Question/Abstract:
How to find a word in an Array of String
Answer:
{ ... }
const
StringsToSearch: array[0..7] of string = ('hello', 'earth', 'why', 'this', '12',
'people', 'how', 'what');
var
Found: Boolean;
i: Integer;
begin
Found := False;
for i := 0 to 7 do
if Pos(StringsToSearch[i], ALongLongLongString) > 0 then
begin
Found := True;
break;
end;
if Found then
ShowMessage('At least one word was found')
else
ShowMessage('No words found');
end;
2007. június 10., vasárnap
Setting environment variables
Problem/Question/Abstract:
There have been various articles showing how to access the environment variables. This article shows how to create, modify and delete an environment variable.
Answer:
The following simple routine stores a new value in an environment variable. If the the environment variable doesn't exists then it is created. Setting an environment variable to the empty string deletes the variable. The function returns 0 if the variable is set / created successfully, or returns a Windows error code on failure. Note that there is a limit on the amount of space available for environment variables.
function SetEnvVarValue(const VarName,
VarValue: string): Integer;
begin
// Simply call API function
if Windows.SetEnvironmentVariable(PChar(VarName),
PChar(VarValue)) then
Result := 0
else
Result := GetLastError;
end;
It should be noted that changes to environment variables only apply to the current process or to any child processes spawned by the current process.
To pass a custom environment variable to a child process simply:
Create the new environment variable using SetDOSEnvVar.
Execute the new program.
So, to pass the current environment + a an environment variable FOO=Bar to a child process do:
{ snip ... }
var
ErrCode: Integer;
begin
ErrCode := SetEnvVarValue('FOO', 'Bar');
if ErrCode = 0 then
WinExec('MyChildProg.exe', SW_SHOWNORMAL);
else
ShowMessage(SysErrorMessage(ErrCode));
end;
{ ... end snip }
The new program can access the new variable using any of the techniques described in other articles.
It is also possible to pass a custom environment variable block to another process. The method for doing this is covered by another article.
A demo program that demonstrates this and other environment variable techniques is available for download here.
2007. június 9., szombat
Extract WAV files from Audio CD
Problem/Question/Abstract:
Not a real, professional way, but it works. You can also select what tipe of file to grab (bitrate, mono/stereo, Hz).
Answer:
Simply use that trick to made your rippers/grabers:
(don't know if it work on NT / 2000)
Download the substitutive FSCD.VXD from the Net and substitute to your original located in
\Windows\System\IOSubSys directory.
I suppose it needs a reboot.
In your program, in the "Grab" button just put in the function that calculates the location of the file and makes a copy of it.
( probabily this will not work, but it demonstrates how to make)
procedure TfrmMain.cmdGrabClick(Sender: TObject);
var
mHz: string;
mBr: string;
mStereo: string;
mTrack: string;
mFile: string;
begin
case rgHz.ItemIndex of
0: mHz := '11025kHz';
1: mHz := '22050kHz';
2: mHz := '44100kHz';
else
mHz := '48000kHz';
end;
if (rgBr.ItemIndex = 0) then
mBr := '8bit'
else
mBr := '16bit';
if (chkStereo.Cheched) then
mStereo := 'Stereo'
else
mStereo := 'Mono';
mTrack := 'Track ' + cboTrack.Text + '.wav';
mFile := cboDrive.Text + ':\' + mStereo + '\' + mHz + '\' + mBr + '\' + mTrack;
// Copy now the file in mFile.
end;
2007. június 8., péntek
Get notified: CD in/out
Problem/Question/Abstract:
Need to know when the user inserts/extracts a CD?
Answer:
there's a message you can intercept to know this: WM_DEVICECHANGE
so... the rest is easy on the private section of your form, declare the function:
Private
{ Private declarations }
procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
the implement it:
procedure TForm1.WMDeviceChange(var Msg: TMessage);
const
CD_IN = $8000;
CD_OUT = $8004;
begin
inherited;
case Msg.wParam of
CD_IN: ShowMessage('CD in'); //or do whatever you want!!
CD_OUT: ShowMessage('CD out')
end
end;
that's it... you'll receive a message when you put a CD in/out... try it then just instead of showing 'CD in'/'CD out'... do whatever you want
2007. június 7., csütörtök
Merge the sections of two TIniFiles
Problem/Question/Abstract:
Imagine there are two win.ini files and I want to combine both together. Some of the common sections and keys/ values are the same in each but they differ in their data generally. How could I merge the two together to get an ini file that contains all the data from both in the right places?
Answer:
Iterate over the sections in the source file. For each section, iterate over the names. If there is a name in Source that already exists in Dest, Dest's copy will be overwritten.
{ ... }
var
Source, Dest: TIniFile;
SectionNames: TStrings;
i: Integer;
begin
SectionNames := TStringList.Create;
try
Source.ReadSections(SectionNames);
for i := 0 to SectionNames.Count - 1 do
begin
MergeSection(Source, Dest, SectionNames[i]);
end;
finally
SectionNames.Free;
end;
end;
procedure MergeSection(Source, Dest: TIniFile; const SectionName: string);
var
i: Integer;
Section: TStrings;
Name, Value: string;
begin
Section := TStringList.Create;
try
Source.ReadSection(SectionName, Section);
for i := 0 to Section.Count - 1 do
begin
Name := Section.Names[i];
Value := Section.Values[Name];
Dest.WriteString(SectionName, Name, Value);
end;
finally
Section.Free;
end;
end;
2007. június 6., szerda
Create/Alter/Delete tables and fields in Access using SQL
Problem/Question/Abstract:
How to Create/Alter/Delete tables and fields in Access using SQL
Answer:
How to Create a Table in Access Using SQL
Even if you don't have the ability to run Access on your PC, you can still create tables in an Access database using ASP and SQL.
Here is a general look at the "Create Table" command:
CREATE TABLE tablename (
id Counter Primary Key,
fieldname_1 type NOT NULL,
fieldname_2 type NOT NULL
);
Notes:
Be sure to NOT modify the section "id Counter Primary Key" Every table you create should have an auto-incrementing primary key field. Always naming this field "id" is a good practice as well.
Be sure to replace "tablename" with the actual name you want to call your new table.
Be sure to replace "fieldname_1" and "fieldname_2" with the actual field names you want in your new table. You can have as many fields as you need, not just two!
Be sure to replace "type" with the actual type of data you want your field to hold.
Some valid options for "type" include:
Counter - An auto-incrementing number.
Currency - Used for holding financial numbers.
Datetime - Used to hold formal date and time information. However, it is easier to make date fields using "Text(50)" instead of actual "datetime" fields. Every database uses a different deafult format for dates, and it is difficult to keep track. So the easiest method is to hold dates in a text field and translate that to an actual date in your programming language of choice rather than having the database keep track of an actual formatted date.
Long - A number that can include decimal places.
LongText - A text field that can hold billions of characters.
Text(n) - where n is a number between 1-255, this is the maximum number of characters that can be held in this field.
How to Alter a Table in Access Using SQL
Even if you don't have the ability to run Access on your PC, you can still alter tables in an Access database using ASP and SQL. The examples below use the "Birthdays" table we created in the Create Table tutorial. There are three ways to alter a table in any database: 1) add a column, 2) modify a column, 3) delete a column.
Here is a general look at the "Alter Table" command:
ALTER TABLE tablename ADD/ALTER/DROP COLUMN fieldname type NOT NULL;
Notes:
Be sure to replace "tablename" with the actual name of the table you want to modify.
Be sure to select only one action from "ADD/ALTER/DROP" depending on how you want to modify your table.
Be sure to replace "fieldname" with the actual field name you want to modify in your table.
Be sure to replace "type" with the actual type of data you want your field to hold.
Some valid options for "type" include:
Counter - An auto-incrementing number.
Currency - Used for holding financial numbers.
Datetime - Used to hold formal date and time information. However, it is easier to make date fields using "Text(50)" instead of actual "datetime" fields. Every database uses a different deafult format for dates, and it is difficult to keep track. So the easiest method is to hold dates in a text field and translate that to an actual date in your programming language of choice rather than having the database keep track of an actual formatted date.
Long - A number that can include decimal places.
LongText - A text field that can hold billions of characters.
Text(n) - where n is a number between 1-255, this is the maximum number of characters that can be held in this field.
Part 1 - Adding a column to a table
The following SQL statement will add a column called "zodiac_sign" to our table (zodiac_sign will be a text column with a maximum length of 50 characters):
ALTER TABLE Birthdays ADD COLUMN zodiac_sign Text(50) NOT NULL;
Part 2 - Modifying a column in a table
The following SQL statement will modify the field called "dob" in our table by changing it from a text field to a datetime field. (zodiac_sign will be a text column with a maximum length of 50 characters):
ALTER TABLE Birthdays ALTER COLUMN dob datetime NOT NULL;
Part 3 - Deleting a column from a table
The following SQL statement will delete the field called "zodiac_sign" from our table:
ALTER TABLE Birthdays DROP COLUMN zodiac_sign;
How to Delete a Table in Access Using SQL
Here is a general look at the "Drop Table" command:
DROP TABLE tablename;
Notes:
Be sure to replace "tablename" with the actual name of the table you want to delete.
2007. június 5., kedd
Combine multiple wave files into a single one
Problem/Question/Abstract:
Does anyone have a snippet of code in Delphi to combine multiple WAV files into one? I am writing a very simple text-to-speech application for Chinese pronounciation. I have all the wave files needed to synthesize Chinese pronounciation (506 files in all). Now, all I need is the ability to create one wave file based on a list of multiple wave files which are in a specific order.
Answer:
This one should work with any PCM format as long as all files are the same format:
procedure JoinWaves(FileList: TStrings; OutputFile: string);
{All files must be of the same format}
var
I: Integer;
FileSize: LongInt;
InStream, OutStream: TFileStream;
begin
OutStream := TFileStream.Create(OutputFile, fmCreate);
try
for I := 0 to FileList.Count - 1 do
if FileExists(FileList[I]) then
begin
InStream := TFileStream.Create(FileList[I], fmOpenRead);
try
if I = 0 then
OutStream.CopyFrom(InStream, InStream.Size)
else if InStream.Size > 44 then
begin
InStream.Position := 44;
OutStream.CopyFrom(InStream, InStream.Size - 44);
end;
finally
InStream.Free;
end;
end;
OutStream.Position := 4;
FileSize := OutStream.Size - 8;
OutStream.WriteBuffer(FileSize, SizeOf(FileSize));
OutStream.Position := 40;
FileSize := OutStream.Size - 44;
OutStream.WriteBuffer(FileSize, SizeOf(FileSize));
finally
OutStream.Free;
end;
end;
Does anyone have a snippet of code in Delphi to combine multiple WAV files into one? I am writing a very simple text-to-speech application for Chinese pronounciation. I have all the wave files needed to synthesize Chinese pronounciation (506 files in all). Now, all I need is the ability to create one wave file based on a list of multiple wave files which are in a specific order.
Answer:
This one should work with any PCM format as long as all files are the same format:
procedure JoinWaves(FileList: TStrings; OutputFile: string);
{All files must be of the same format}
var
I: Integer;
FileSize: LongInt;
InStream, OutStream: TFileStream;
begin
OutStream := TFileStream.Create(OutputFile, fmCreate);
try
for I := 0 to FileList.Count - 1 do
if FileExists(FileList[I]) then
begin
InStream := TFileStream.Create(FileList[I], fmOpenRead);
try
if I = 0 then
OutStream.CopyFrom(InStream, InStream.Size)
else if InStream.Size > 44 then
begin
InStream.Position := 44;
OutStream.CopyFrom(InStream, InStream.Size - 44);
end;
finally
InStream.Free;
end;
end;
OutStream.Position := 4;
FileSize := OutStream.Size - 8;
OutStream.WriteBuffer(FileSize, SizeOf(FileSize));
OutStream.Position := 40;
FileSize := OutStream.Size - 44;
OutStream.WriteBuffer(FileSize, SizeOf(FileSize));
finally
OutStream.Free;
end;
end;
2007. június 4., hétfő
Find out what is you IP adress
Problem/Question/Abstract:
If you want to find out what is your actual IP, this is the right thing for you.
Answer:
Start by creating a new application. Add a Button and two Edit Boxes to your project. Remember not to name them. Just leave them the way they are. In the unit add to uses: winsock.
After that double click on the Button you have just created and in the unit paste the following script instead of the begin function:
function GetIPFromHost
(var HostName, IPaddr, WSAErr: string): Boolean;
type
Name = array[0..100] of Char;
PName = ^Name;
var
HEnt: pHostEnt;
HName: PName;
WSAData: TWSAData;
i: Integer;
begin
Result := False;
if WSAStartup($0101, WSAData) <> 0 then begin
WSAErr := 'Winsock is not responding."';
Exit;
end;
IPaddr := '';
New(HName);
if GetHostName(HName^, SizeOf(Name)) = 0 then
begin
HostName := StrPas(HName^);
HEnt := GetHostByName(HName^);
for i := 0 to HEnt^.h_length - 1 do
IPaddr :=
Concat(IPaddr,
IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.');
SetLength(IPaddr, Length(IPaddr) - 1);
Result := True;
end
else begin
case WSAGetLastError of
WSANOTINITIALISED:WSAErr:='WSANotInitialised';
WSAENETDOWN :WSAErr:='WSAENetDown';
WSAEINPROGRESS :WSAErr:='WSAEInProgress';
end;
end;
Dispose(HName);
WSACleanup;
end;
var
Host, IP, Err: string;
begin
if GetIPFromHost(Host, IP, Err) then begin
Edit1.Text := Host;
Edit2.Text := IP;
end
else
MessageDlg(Err, mtError, [mbOk], 0);
end;
After pasting all this just delete the other end; that is left at the end of the source. That's it. This source was not originally made by me but was modified by me. Hope you find it useful. Good luck!
If you want to find out what is your actual IP, this is the right thing for you.
Answer:
Start by creating a new application. Add a Button and two Edit Boxes to your project. Remember not to name them. Just leave them the way they are. In the unit add to uses: winsock.
After that double click on the Button you have just created and in the unit paste the following script instead of the begin function:
function GetIPFromHost
(var HostName, IPaddr, WSAErr: string): Boolean;
type
Name = array[0..100] of Char;
PName = ^Name;
var
HEnt: pHostEnt;
HName: PName;
WSAData: TWSAData;
i: Integer;
begin
Result := False;
if WSAStartup($0101, WSAData) <> 0 then begin
WSAErr := 'Winsock is not responding."';
Exit;
end;
IPaddr := '';
New(HName);
if GetHostName(HName^, SizeOf(Name)) = 0 then
begin
HostName := StrPas(HName^);
HEnt := GetHostByName(HName^);
for i := 0 to HEnt^.h_length - 1 do
IPaddr :=
Concat(IPaddr,
IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.');
SetLength(IPaddr, Length(IPaddr) - 1);
Result := True;
end
else begin
case WSAGetLastError of
WSANOTINITIALISED:WSAErr:='WSANotInitialised';
WSAENETDOWN :WSAErr:='WSAENetDown';
WSAEINPROGRESS :WSAErr:='WSAEInProgress';
end;
end;
Dispose(HName);
WSACleanup;
end;
var
Host, IP, Err: string;
begin
if GetIPFromHost(Host, IP, Err) then begin
Edit1.Text := Host;
Edit2.Text := IP;
end
else
MessageDlg(Err, mtError, [mbOk], 0);
end;
After pasting all this just delete the other end; that is left at the end of the source. That's it. This source was not originally made by me but was modified by me. Hope you find it useful. Good luck!
2007. június 3., vasárnap
Change font color, size, style, and back color of certain words inside a rich edit
Problem/Question/Abstract:
Do you want to have a nice looking rich edit?
Answer:
This procedure will search and change the attributes (font name, font size, font color, font style, and back color) of certain words inside a rich edit control. Try the example.
type
TTextAttributes = record
Font: TFont;
BackColor: TColor;
end;
{..}
procedure SetTextColor(oRichEdit: TRichEdit; sText: string; rAttributes:
TTextAttributes);
var
iPos: Integer;
iLen: Integer;
Format: CHARFORMAT2;
begin
FillChar(Format, SizeOf(Format), 0);
Format.cbSize := SizeOf(Format);
Format.dwMask := CFM_BACKCOLOR;
Format.crBackColor := rAttributes.BackColor;
iPos := 0;
iLen := Length(oRichEdit.Lines.Text);
iPos := oRichEdit.FindText(sText, iPos, iLen, []);
while iPos <> -1 do
begin
oRichEdit.SelStart := iPos;
oRichEdit.SelLength := Length(sText);
oRichEdit.SelAttributes.Color := rAttributes.Font.Color;
oRichEdit.SelAttributes.Size := rAttributes.Font.Size;
oRichEdit.SelAttributes.Style := rAttributes.Font.Style;
oRichEdit.SelAttributes.Name := rAttributes.Font.Name;
oRichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
iPos := oRichEdit.FindText(sText, iPos + Length(sText), iLen, []);
end;
end;
Example:
var
rAttrib: TTextAttributes;
begin
rAttrib.Font := TFont.Create;
rAttrib.Font.Color := clWhite;
rAttrib.Font.Size := 16;
rAttrib.Font.Style := [fsBold];
rAttrib.BackColor := clRed;
SetTextColor(RichEdit1, 'Delphi', rAttrib);
//Change another word attributes.
rAttrib.Font.Color := clYellow;
rAttrib.Font.Size := 10;
rAttrib.Font.Style := [fsBold, fsItalic];
rAttrib.BackColor := clBlue;
SetTextColor(RichEdit1, 'Is greate', rAttrib);
rAttrib.Font.Free; //Now free the font.
end;
Do you want to have a nice looking rich edit?
Answer:
This procedure will search and change the attributes (font name, font size, font color, font style, and back color) of certain words inside a rich edit control. Try the example.
type
TTextAttributes = record
Font: TFont;
BackColor: TColor;
end;
{..}
procedure SetTextColor(oRichEdit: TRichEdit; sText: string; rAttributes:
TTextAttributes);
var
iPos: Integer;
iLen: Integer;
Format: CHARFORMAT2;
begin
FillChar(Format, SizeOf(Format), 0);
Format.cbSize := SizeOf(Format);
Format.dwMask := CFM_BACKCOLOR;
Format.crBackColor := rAttributes.BackColor;
iPos := 0;
iLen := Length(oRichEdit.Lines.Text);
iPos := oRichEdit.FindText(sText, iPos, iLen, []);
while iPos <> -1 do
begin
oRichEdit.SelStart := iPos;
oRichEdit.SelLength := Length(sText);
oRichEdit.SelAttributes.Color := rAttributes.Font.Color;
oRichEdit.SelAttributes.Size := rAttributes.Font.Size;
oRichEdit.SelAttributes.Style := rAttributes.Font.Style;
oRichEdit.SelAttributes.Name := rAttributes.Font.Name;
oRichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
iPos := oRichEdit.FindText(sText, iPos + Length(sText), iLen, []);
end;
end;
Example:
var
rAttrib: TTextAttributes;
begin
rAttrib.Font := TFont.Create;
rAttrib.Font.Color := clWhite;
rAttrib.Font.Size := 16;
rAttrib.Font.Style := [fsBold];
rAttrib.BackColor := clRed;
SetTextColor(RichEdit1, 'Delphi', rAttrib);
//Change another word attributes.
rAttrib.Font.Color := clYellow;
rAttrib.Font.Size := 10;
rAttrib.Font.Style := [fsBold, fsItalic];
rAttrib.BackColor := clBlue;
SetTextColor(RichEdit1, 'Is greate', rAttrib);
rAttrib.Font.Free; //Now free the font.
end;
2007. június 2., szombat
Show bullets in a TRichEdit
Problem/Question/Abstract:
How to show bullets in a TRichEdit?
Answer:
uses
RichEdit;
procedure TForm1.Button1Click(Sender: TObject);
var
fmt: TParaformat2;
begin
FillChar(fmt, SizeOf(fmt), 0);
fmt.cbSize := SizeOf(fmt);
// The PARAFORMAT2 structure is used to set the numbering style.
// This is done through the following structure members:
fmt.dwMask := PFM_NUMBERING or PFM_NUMBERINGSTART or PFM_NUMBERINGSTYLE or
PFM_NUMBERINGTAB;
// Set the following values (bitwise-or them together) to identify
// which of the remaining structure members are valid:
// PFM_NUMBERING, PFM_NUMBERINGSTART, PFM_NUMBERINGSTYLE, and PFM_NUMBERINGTAB
fmt.wNumbering := 2;
//0 no numbering or bullets
//1 (PFN_BULLET) uses bullet character
//2 Uses Arabic numbers (1, 2, 3, ...).
//3 Uses lowercase letters (a, b, c, ...).
//4 Uses uppercase letters (A, B, C, ...).
//5 Uses lowercase Roman numerals (i, ii, iii, ...).
//6 Uses uppercase Roman numerals (I, II, III, ...).
//7 Uses a sequence of characters beginning with the Unicode
// character specified by the wNumberingStart member.
fmt.wNumberingStart := 1;
// Starting value for numbering.
fmt.wNumberingStyle := $200;
// Styles for numbering:
// 0 : Follows the number with a right parenthesis. 1)
// $100 : Encloses the number in parentheses. (1)
// $200 : Follows the number with a period. 1.
// $300 : Displays only the number. 1
// $400 : Continues a numbered list without applying the next number or bullet.
// $8000 : Starts a new number with wNumberingStart.
fmt.wNumberingTab := 1440 div 4;
// Minimum space between a paragraph number and the paragraph text, in twips
RichEdit1.Perform(EM_SETPARAFORMAT, 0, lParam(@fmt));
end;
How to show bullets in a TRichEdit?
Answer:
uses
RichEdit;
procedure TForm1.Button1Click(Sender: TObject);
var
fmt: TParaformat2;
begin
FillChar(fmt, SizeOf(fmt), 0);
fmt.cbSize := SizeOf(fmt);
// The PARAFORMAT2 structure is used to set the numbering style.
// This is done through the following structure members:
fmt.dwMask := PFM_NUMBERING or PFM_NUMBERINGSTART or PFM_NUMBERINGSTYLE or
PFM_NUMBERINGTAB;
// Set the following values (bitwise-or them together) to identify
// which of the remaining structure members are valid:
// PFM_NUMBERING, PFM_NUMBERINGSTART, PFM_NUMBERINGSTYLE, and PFM_NUMBERINGTAB
fmt.wNumbering := 2;
//0 no numbering or bullets
//1 (PFN_BULLET) uses bullet character
//2 Uses Arabic numbers (1, 2, 3, ...).
//3 Uses lowercase letters (a, b, c, ...).
//4 Uses uppercase letters (A, B, C, ...).
//5 Uses lowercase Roman numerals (i, ii, iii, ...).
//6 Uses uppercase Roman numerals (I, II, III, ...).
//7 Uses a sequence of characters beginning with the Unicode
// character specified by the wNumberingStart member.
fmt.wNumberingStart := 1;
// Starting value for numbering.
fmt.wNumberingStyle := $200;
// Styles for numbering:
// 0 : Follows the number with a right parenthesis. 1)
// $100 : Encloses the number in parentheses. (1)
// $200 : Follows the number with a period. 1.
// $300 : Displays only the number. 1
// $400 : Continues a numbered list without applying the next number or bullet.
// $8000 : Starts a new number with wNumberingStart.
fmt.wNumberingTab := 1440 div 4;
// Minimum space between a paragraph number and the paragraph text, in twips
RichEdit1.Perform(EM_SETPARAFORMAT, 0, lParam(@fmt));
end;
2007. június 1., péntek
Check if a printer supports postscript
Problem/Question/Abstract:
How to check if a printer supports postscript?
Answer:
That is really difficult do to if it has to work on all Windows platforms. The best way (no kidding) may be to ask the user which printer to use. What platforms do you need to support? If it is only Win2K (and perhaps XP) one may be able to use this (i have no postscript-enabled printer around to see if it works!):
uses
WinSpool, Printers;
{: Check if the currently selected printer supports postscript.
Only applicable on Win2K/XP! }
function PrinterSupportsPostscript: Boolean;
const
POSTSCRIPT_PASSTHROUGH = 4115;
POSTSCRIPT_IDENTIFY = 4117;
Escapes: array[0..2] of Cardinal =
(POSTSCRIPT_DATA, POSTSCRIPT_IDENTIFY, POSTSCRIPT_PASSTHROUGH);
var
res: Integer;
i: Integer;
begin
Result := false;
for i := Low(Escapes) to High(Escapes) do
begin
res := ExtEscape(printer.Handle,
QUERYESCSUPPORT,
sizeof(Escapes[0]),
@Escapes[i], 0, nil);
if res <> 0 then
begin
Result := true;
Break;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
boolstr: array[Boolean] of string = (' not', '');
var
i: Integer;
S: string;
begin
for i := 0 to Printer.Printers.Count - 1 do
begin
Printer.PrinterIndex := i;
memo1.Lines.add(
Format('Printer %s does%s support Postscript',
[printer.printers[printer.printerindex],
boolstr[PrinterSupportsPostscript]]));
end;
end;
How to check if a printer supports postscript?
Answer:
That is really difficult do to if it has to work on all Windows platforms. The best way (no kidding) may be to ask the user which printer to use. What platforms do you need to support? If it is only Win2K (and perhaps XP) one may be able to use this (i have no postscript-enabled printer around to see if it works!):
uses
WinSpool, Printers;
{: Check if the currently selected printer supports postscript.
Only applicable on Win2K/XP! }
function PrinterSupportsPostscript: Boolean;
const
POSTSCRIPT_PASSTHROUGH = 4115;
POSTSCRIPT_IDENTIFY = 4117;
Escapes: array[0..2] of Cardinal =
(POSTSCRIPT_DATA, POSTSCRIPT_IDENTIFY, POSTSCRIPT_PASSTHROUGH);
var
res: Integer;
i: Integer;
begin
Result := false;
for i := Low(Escapes) to High(Escapes) do
begin
res := ExtEscape(printer.Handle,
QUERYESCSUPPORT,
sizeof(Escapes[0]),
@Escapes[i], 0, nil);
if res <> 0 then
begin
Result := true;
Break;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
boolstr: array[Boolean] of string = (' not', '');
var
i: Integer;
S: string;
begin
for i := 0 to Printer.Printers.Count - 1 do
begin
Printer.PrinterIndex := i;
memo1.Lines.add(
Format('Printer %s does%s support Postscript',
[printer.printers[printer.printerindex],
boolstr[PrinterSupportsPostscript]]));
end;
end;
2007. május 31., csütörtök
Bitmap blending
Problem/Question/Abstract:
How to show an image changing into another.
Answer:
In a previous post I provided a function that takes 2 TBitmap arguments and returns a crossfaded image obtained by combining the two bitmaps.
That can be used to make an animation that shows a bitmap morphing into another bitmap.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, jpeg;
type
TForm1 = class(TForm)
Button1: TButton;
Image3: TImage;
esteps: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function mix(img1, img2: TBitmap; steps, stepno: integer): TBitmap;
var
x, y, height, width: integer;
pimg1, pimg2, pres: PByteArray;
res: TBitmap;
begin
res := TBitmap.Create;
if img1.Height > img2.Height then
height := img2.Height
else
height := img1.Height;
if img1.Width > img1.Width then
width := img2.Width
else
width := img1.Width;
img1.PixelFormat := pf24bit;
img2.PixelFormat := pf24bit;
res.PixelFormat := pf24bit;
res.Width := width;
res.Height := height;
for y := 0 to height - 1 do
begin
pimg1 := img1.ScanLine[y];
pimg2 := img2.ScanLine[y];
pres := res.ScanLine[y];
for x := 0 to width - 1 do
begin
pres^[x * 3] := pimg1^[x * 3] * (steps - stepno) div steps +
pimg2[x * 3] * stepno div steps;
pres^[x * 3 + 1] := pimg1^[x * 3 + 1] * (steps - stepno) div steps +
pimg2[x * 3 + 1] * stepno div steps;
pres^[x * 3 + 2] := pimg1^[x * 3 + 2] * (steps - stepno) div steps +
pimg2[x * 3 + 2] * stepno div steps;
end;
end;
result := res;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
steps, i: integer;
img1, img2: TBitmap;
begin
if esteps.text <> '' then
begin
steps := strtoint(esteps.text);
img1 := TBitmap.Create;
img2 := TBitmap.Create;
img1.LoadFromFile('e:\untitled.bmp');
img2.LoadFromFile('e:\untitled1.bmp');
for i := 1 to steps do
begin
image3.Picture.Bitmap := mix(img1, img2, steps, i);
image3.Refresh;
sleep(30);
end;
img1.Free;
img2.Free;
end
else
messagedlg('Please provide the number of steps for morphing', mterror, [mbok], 0);
end;
end.
I have a form with a button on it, a TImage object and an edit box. The editbox is used to provide the number of steps in wich morphing will occur. I load two bitmaps and the morphing is showed in the TImage object. The function mix is mixing two images in a certain proportion calculated from the values of the steps and stepno.
How to show an image changing into another.
Answer:
In a previous post I provided a function that takes 2 TBitmap arguments and returns a crossfaded image obtained by combining the two bitmaps.
That can be used to make an animation that shows a bitmap morphing into another bitmap.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, jpeg;
type
TForm1 = class(TForm)
Button1: TButton;
Image3: TImage;
esteps: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function mix(img1, img2: TBitmap; steps, stepno: integer): TBitmap;
var
x, y, height, width: integer;
pimg1, pimg2, pres: PByteArray;
res: TBitmap;
begin
res := TBitmap.Create;
if img1.Height > img2.Height then
height := img2.Height
else
height := img1.Height;
if img1.Width > img1.Width then
width := img2.Width
else
width := img1.Width;
img1.PixelFormat := pf24bit;
img2.PixelFormat := pf24bit;
res.PixelFormat := pf24bit;
res.Width := width;
res.Height := height;
for y := 0 to height - 1 do
begin
pimg1 := img1.ScanLine[y];
pimg2 := img2.ScanLine[y];
pres := res.ScanLine[y];
for x := 0 to width - 1 do
begin
pres^[x * 3] := pimg1^[x * 3] * (steps - stepno) div steps +
pimg2[x * 3] * stepno div steps;
pres^[x * 3 + 1] := pimg1^[x * 3 + 1] * (steps - stepno) div steps +
pimg2[x * 3 + 1] * stepno div steps;
pres^[x * 3 + 2] := pimg1^[x * 3 + 2] * (steps - stepno) div steps +
pimg2[x * 3 + 2] * stepno div steps;
end;
end;
result := res;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
steps, i: integer;
img1, img2: TBitmap;
begin
if esteps.text <> '' then
begin
steps := strtoint(esteps.text);
img1 := TBitmap.Create;
img2 := TBitmap.Create;
img1.LoadFromFile('e:\untitled.bmp');
img2.LoadFromFile('e:\untitled1.bmp');
for i := 1 to steps do
begin
image3.Picture.Bitmap := mix(img1, img2, steps, i);
image3.Refresh;
sleep(30);
end;
img1.Free;
img2.Free;
end
else
messagedlg('Please provide the number of steps for morphing', mterror, [mbok], 0);
end;
end.
I have a form with a button on it, a TImage object and an edit box. The editbox is used to provide the number of steps in wich morphing will occur. I load two bitmaps and the morphing is showed in the TImage object. The function mix is mixing two images in a certain proportion calculated from the values of the steps and stepno.
2007. május 30., szerda
How to load HTML code from a string into a TWebBrowser
Problem/Question/Abstract:
How to load HTML code from a string into a TWebBrowser
Answer:
First, add ActiveX to the unit's Uses clause.
With this procedure you'll be able to do so.
procedure LoadHTMLCode(WebBrowser: TWebBrowser; HTMLCode: string);
var
sl: TStringList;
ms: TMemoryStream;
begin
WebBrowser.Navigate('about:blank');
while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
Application.ProcessMessages;
if Assigned(WebBrowser.Document) then
begin
sl := TStringList.Create;
try
ms := TMemoryStream.Create;
try
sl.Text := HTMLCode;
sl.SaveToStream(ms);
ms.Seek(0, 0);
(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
finally
ms.Free;
end;
finally
sl.Free;
end;
end;
end;
An example :
LoadHTMLCode(WebBrowser1,Memo1.Text) ;
How to load HTML code from a string into a TWebBrowser
Answer:
First, add ActiveX to the unit's Uses clause.
With this procedure you'll be able to do so.
procedure LoadHTMLCode(WebBrowser: TWebBrowser; HTMLCode: string);
var
sl: TStringList;
ms: TMemoryStream;
begin
WebBrowser.Navigate('about:blank');
while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
Application.ProcessMessages;
if Assigned(WebBrowser.Document) then
begin
sl := TStringList.Create;
try
ms := TMemoryStream.Create;
try
sl.Text := HTMLCode;
sl.SaveToStream(ms);
ms.Seek(0, 0);
(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
finally
ms.Free;
end;
finally
sl.Free;
end;
end;
end;
An example :
LoadHTMLCode(WebBrowser1,Memo1.Text) ;
2007. május 29., kedd
InterBase Stored Procedures
Problem/Question/Abstract:
Creating Them and Using Them from Delphi
Answer:
One of the cornerstones of successful client/server programming is the stored procedure. Unfortunately, InterBase stored procedures are woefully underdocumented, especially regarding the Delphi connection. This article attempts to help fill the documentation gap.
This article has two major goals. The first is to provide a general description of an InterBase stored procedure, describe the benefits of stored procedures, and provide specific examples of the more common procedures you'll need to create. The second is to explain how Delphi uses the stored procedures, i.e. explain how they're called.
What Is a Stored Procedure?
A stored procedure is a routine written in InterBase trigger and procedure language (catchy, hunh?) that can be called by a client (e.g. a Delphi application) or another procedure or trigger. Stored procedures can be used for many things, but this article will focus on their use with the mainstay SQL statements: SELECT, INSERT, UPDATE, and DELETE.
Select statements are the most common, so let's tackle them first. A stored procedure that contains a SQL SELECT statement is often referred to as a select procedure.
Stored Procedure Basics
An InterBase stored procedure is created using a CREATE PROCEDURE statement. The code in Figure 1, for example, creates a select procedure named SPS_Address_ProviderID. This straightforward select procedure returns four columns from any Address table row that has a ProviderID column value equal to the ProviderID provided as an input argument.
CREATE PROCEDURE SPS_Address_ProviderID(ProviderID INTEGER)
RETURNS (Address CHAR(60),
City CHAR(30),
State CHAR( 2),
ZipCode CHAR( 5))
AS
BEGIN
FOR
SELECT Address, City, State, ZipCode
FROM Address
WHERE ProviderID = :ProviderID
INTO :Address, :City, :State, :ZipCode
DO SUSPEND;
END
Figure 1: An example of a select procedure.
As you can see, a select procedure is essentially a SQL SELECT statement in the form of a function call. Input parameters - if there are any - are included in the CREATE statement as a comma-delimited list within parentheses. There's only one in this example; it's named ProviderID, and is of type INTEGER. The InterBase data types are shown in Figure 2.
Name
Size
Range/Precision
BLOB
variable
None - BLOB segment size is limited to 64KB
CHAR(n)
n characters
1 to 32767 bytes
DATE
64 bits
1 Jan 100 to 11 Dec 5941
DECIMAL(precision, scale)
variable
precision = 1 to 15, least number of precision digits
scale = 1 to 15, number of decimal places
DOUBLE PRECISION
64 bits
1.7 x 10-308 to 1.7 x 10308
FLOAT
32 bits
3.4 x 10-38 to 3.4 x 1038
INTEGER
32 bits
-2,147,483,648 to 2,147,483,648
NUMERIC(precision, scale)
variable
same as DECIMAL
SMALLINT
16 bits
-32768 to 32767
VARCHAR(n)
n characters
1 to 32765 bytes
Figure 2: InterBase data types (based on a chart from the InterBase Workgroup Server Data Definition Guide, pages 46-7).
Any output parameters - and there must be at least one for a select procedure - are described in a RETURNS statement, which also takes the form of a comma-delimited list inside parentheses. In this example, there are four output parameters: Address, City, State, and ZipCode. All are of type CHAR, which is used for strings.
Header and body. The CREATE and RETURNS statements (if RETURNS is present) comprise the stored procedure's header. Everything following the AS keyword is the procedure's body. In this example, the body is contained entirely within the BEGIN and END statements required for every stored procedure.
There can also be statements between the AS and BEGIN keywords that are considered part of the body. These statements declare local variables for the stored procedure; we'll discuss them later, along with the FOR, INTO, and DO SUSPEND statements.
Why Use Them?
They're fast. A query stored on the server as a procedure executes far more quickly than one built and executed on the client. The speed difference is even more pronounced when your database application is running on a LAN or WAN. The main reason is that when the client application sends the query to the server, the server responds with a large amount of metadata (specific database information about the requested query). The query plan is then built, and the query is re-sent to the server for execution.
In contrast, if a stored procedure is used to perform the SQL statement, the client simply requests that the server execute the procedure, and send back the answer set (if any). The result is that just two trips are made between the client and server, instead of four (one of which contains a large amount of data).
They're reusable. In a database application of significant size, you'll find yourself using the same SQL statements (SELECTs, INSERTs, etc.) repeatedly. Rather than recreate a statement on the client each time, it's better to store the statement in the database and call it. It's the same idea as maintaining a library of procedures and functions shared between modules. The benefits are the same, as well: Readability is enhanced, and redundancy, maintenance, and documentation are greatly reduced.
They're part of the database. Although this has been mentioned, it bears repeating that a stored procedure is part of the database. Not only does this make the procedure readily accessible to the database, it also insures that the procedure is syntactically correct, and that the SQL statements included in the procedure are correct. The database will not accept it until it's valid, i.e. the CREATE PROCEDURE statement will fail.
Creating Select Procedures
We'll examine five types of stored procedures:
a SELECT statement that may return multiple rows
a SELECT statement that returns one row, i.e. a singleton select
an INSERT statement
an UPDATE statement
a DELETE statement
Creating a Multi-Row SELECT
When a SELECT statement might return multiple rows, the stored procedure must use the FOR...DO looping construct. We've already seen this in Figure 1:
FOR
SELECT Address, City, State, ZipCode
FROM Address
WHERE ProviderID = :ProviderID
INTO :Address, :City, :State, :ZipCode
DO SUSPEND;
Here a FOR...DO loop has been placed around the SELECT statement. This will cause the SUSPEND command to be executed for each row returned by the SELECT statement. (SQL programmers will recognize this as a fetch loop on an open cursor.)
Fine - but what does SUSPEND do? It's got a lousy name, but a SUSPEND command is absolutely necessary to make the SELECT stored procedure work. It causes the stored procedure to return a value via the variables associated with the INTO clause. (Note: InterBase will accept a stored procedure without a SUSPEND statement, but the stored procedure will never return a value.)
Loading the Output Variables. An additional clause on the SELECT statement may be new to you. The INTO clause describes the variables that will be loaded with the result of the SELECT statement, then returned by the stored procedure via the variables described in the RETURNS statement. They must agree in number, order, and name, or InterBase will not accept the procedure.
A Singleton SELECT
When a SELECT statement will return only one row, there's no need for a FOR...DO loop (see Figure 3). However, it's important to ensure that the SELECT will never attempt to return more than one row, i.e. that the WHERE clause uses a unique row identifier. If InterBase determines that multiple rows are possible, it will not accept the procedure.
SET TERM ^ ;
CONNECT "c:\doj\cmis\cmis.gdb"^
CREATE PROCEDURE SPS_Subject_Confidential(
ProviderID INTEGER)
RETURNS (ConfideCount INTEGER)
AS
BEGIN
SELECT COUNT(*)
FROM Party P, CaseStatus CS, Status S
WHERE P.ProviderID = :ProviderID
AND CS.ComplaintID = P.ComplaintID
AND CS.Status = S.Status
AND S.ConfidentialityFlag = 'T'
AND CS.StatusDate =
( SELECT MAX(StatusDate)
FROM CaseStatus Case
WHERE Case.ComplaintID = P.ComplaintID )
INTO :ConfideCount;
SUSPEND;
END^
SET TERM ; ^
Figure 3: This ISQL script creates a singleton select. This COUNT statement will always return one row, so there is no need for the FOR...DO loop.
The SELECT statement in Figure 3 is returning the result of the aggregate function, COUNT, so it will always return one row. (Incidentally, it also features a sub-select. This type of query is useful in any situation where you need to determine the current status row for something - a "case" in this instance.)
The SELECT statement now requires a terminating semicolon:
INTO :ConfideCount;
as does the one-word SUSPEND statement that immediately follows it.
This is in contrast to the stored procedure shown in Figure 1. It may seem odd, but in the multiple SELECT shown in Figure 1, there's only one statement in the body of the procedure: It's a FOR...DO statement that's terminated just after the SUSPEND command:
DO SUSPEND;
Therefore, there is no terminating semicolon for the SELECT itself.
An INSERT
An INSERT statement is used to add a row to an InterBase table. No RETURNS variable is necessary for an INSERT stored procedure (see Figure 4). Not shown is that an InterBase trigger is using a generator to automatically assign a value to a primary key column - a typical scenario. (These issues are discussed in detail in Bill Todd's article, "InterBase Triggers and Generators.")
SET TERM ^ ;
CONNECT "c:\doj\cmis\cmis.gdb"^
CREATE PROCEDURE SPI_Payment
(
MoneyOwedBMCFID INTEGER,
AmountPaid FLOAT,
CheckNumber CHAR(15),
DateOfCheck DATE,
DateMoneyReceived DATE,
DateMoneyDistributed DATE
)
AS
BEGIN
INSERT INTO Payments
(
MoneyOwedBMCFID,
AmountPaid,
CheckNumber,
DateOfCheck,
DateMoneyReceived,
DateMoneyDistributed
)
VALUES
(
:MoneyOwedBMCFID,
:AmountPaid,
:CheckNumber,
:DateOfCheck,
:DateMoneyReceived,
:DateMoneyDistributed
);
END^
SET TERM ; ^
Figure 4: This stored procedure describes a SQL INSERT statement.
An UPDATE
An UPDATE statement is used to modify one or multiple columns of an existing row in an InterBase table. No RETURNS variable is necessary for an UPDATE stored procedure (see Figure 5). However, one or more of the input arguments must be used in a WHERE clause to identify the row to update.
SET TERM ^ ;
CONNECT "c:\doj\cmis\cmis.gdb"^
CREATE PROCEDURE SPU_Penalty
(
PenaltyID INTEGER,
PartyID INTEGER,
PenaltyType CHAR(20),
PenaltyUnitType CHAR(10),
DateOfPenalty DATE,
PenaltyUnits INTEGER
)
AS
BEGIN
UPDATE Penalty
SET PartyID
WHERE PenaltyID = :PenaltyID; = :PartyID,
PenaltyType = :PenaltyType,
PenaltyUnitType = :PenaltyUnitType,
DateOfPenalty = :DateOfPenalty,
PenaltyUnits = :PenaltyUnits
END^
SET TERM ; ^
Figure 5: This stored procedure describes a SQL UPDATE statement.
A DELETE
A DELETE statement is used to remove an existing row or rows from an InterBase table. No RETURNS variable is necessary for a DELETE stored procedure (see Figure 6). One or more of the input arguments must be used in a WHERE clause to identify the row(s) to delete.
SET TERM ^ ;
CONNECT "c:\doj\cmis\cmis.gdb"^
CREATE PROCEDURE SPD_LicenseToBill (ProviderID INTEGER)
AS
BEGIN
DELETE FROM LicenseToBill
WHERE ProviderID = :ProviderID;
END^
SET TERM ; ^
Figure 6: This stored procedure describes a SQL DELETE statement.
ISQL Scripts
To add a stored procedure to an InterBase database, you must describe the stored procedure in an ISQL script and then run that script using ISQL. The code examples presented so far are ISQL scripts that must be run through InterBase's interactive interface, ISQL (using the menu command File | Run an ISQL Script). A couple of tricks are required to make these scripts work.
First, although you may already have connected to an InterBase database using ISQL (File | Connect to Database), it is still necessary to explicitly connect each time an ISQL script is executed. This is done with a CONNECT statement; for example:
CONNECT "c:\doj\cmis\cmis.gdb"^
The trouble with terminators. Second, an ISQL script must satisfy two masters: the ISQL tool itself, and the InterBase database it addresses. Both require statement terminators, and both use the semicolon (; ) as their default terminator character. Something's gotta give, so you need to temporarily change the terminator for ISQL. This is done with the SET TERM command. This statement, for example:
SET TERM ^ ;
tells ISQL to use the carat (^ ) character as a terminator until further notice. You can use any character you like as the alternate terminator, but I would highly recommend that you use something unusual. Typically, the last statement in an ISQL script replaces the semicolon as the terminating character.
Calling Stored Procedures from Delphi
Okay, we know how to build the stored procedures. Now how do we call them from Delphi? There are two ways - one is necessary for SELECT statements (i.e. statements that return a value), the other for INSERT, UPDATE, and DELETE statements.
Stored procedures with SELECT statements are called from Delphi using a Query object (of class TQuery). This is despite the fact that we're calling a stored procedure; again, a Delphi Query object is used for any statement that returns the result of a SELECT statement. The other SQL statements - INSERT, UPDATE, and DELETE - are called using a Delphi StoredProc object (of class TStoredProc).
Calling a Select Procedure
We'll describe how stored procedures are called, beginning with a SELECT statement. First, however, let's back up a bit and take a look at how we'd describe and call a "conventional" query (i.e. one not contained in a select procedure) using Object Pascal (see Figure 7).
procedure {... }
var
FetchCount: Word;
QueryAddress: TQuery;
{ ... }
QueryAddress := TQuery.Create(Self);
with QueryAddress do
begin
DatabaseName := 'CMIS_DB';
SQL.Add('SELECT AddressType, Address, City, County, ');
SQL.Add(' State, ZipCode, ZipPlus4, PhoneNumber');
SQL.Add(' FROM Address ');
SQL.Add(' WHERE ProviderID = :ProviderID ');
ParamByName('ProviderID').AsInteger :=
SubjectUpdateProviderID;
Open;
FetchCount := 0;
while EOF = False do
begin
with StringGridAddress do
begin
RowCount := FetchCount + 1;
Cells[0, FetchCount] := Fields[0].Text;
Cells[1, FetchCount] := Fields[1].Text;
Cells[2, FetchCount] := Fields[2].Text;
Cells[3, FetchCount] := Fields[3].Text;
Cells[4, FetchCount] := Fields[4].Text;
Cells[5, FetchCount] := Fields[5].Text;
Cells[6, FetchCount] := Fields[6].Text;
Cells[7, FetchCount] := Fields[7].Text;
end;
Inc(FetchCount);
Next;
end;
Free;
end;
{ ... }
end;
Figure 7: Describing and executing a SQL SELECT statement with Object Pascal.
First the Query object, QueryAddress, is instantiated, and its Database and SQL properties are assigned values. Then the single query parameter, ProviderID, is assigned a value, and the query is executed using the Open method. In this example, a while loop is used to take the results of the query and load them into a StringGrid component.
All of this is familiar, but how do we change it to call a stored procedure? For this SELECT statement, the changes are fairly minor (see Figure 8). There are two notable differences:
First, the FROM clause now refers to the name of the stored procedure, SPS_Address_ProviderID, not a specific table. (The difference would be more pronounced if there were a list of tables.)
Second, there is no WHERE clause; the WHERE clause is described in the stored procedure. The input parameter is simply placed in parentheses following the FROM clause. (Again, the difference would have been more pronounced if there had been an elaborate WHERE clause.)
var
FetchCount: Word;
QueryAddress: TQuery;
{ ... }
QueryAddress := TQuery.Create(Self);
with QueryAddress do
begin
DatabaseName := 'CMIS_DB';
SQL.Add('SELECT AddressType, Address, City, County, ');
SQL.Add(' State, ZipCode, ZipPlus4, PhoneNumber');
SQL.Add(' FROM SPS_Address_ProviderID (:ProviderID) ');
ParamByName('ProviderID').AsInteger :=
SubjectUpdateProviderID;
Open;
FetchCount := 0;
while EOF = False do
begin
with StringGridAddress do
begin
RowCount := FetchCount + 1;
Cells[0, FetchCount] := Fields[0].Text;
Cells[1, FetchCount] := Fields[1].Text;
Cells[2, FetchCount] := Fields[2].Text;
Cells[3, FetchCount] := Fields[3].Text;
Cells[4, FetchCount] := Fields[4].Text;
Cells[5, FetchCount] := Fields[5].Text;
Cells[6, FetchCount] := Fields[6].Text;
Cells[7, FetchCount] := Fields[7].Text;
end;
Inc(FetchCount);
Next;
end;
Free;
end;
Figure 8: Executing an InterBase select procedure from Object Pascal.
The rest of the procedure is the same: Multiple rows are being loaded into a StringGrid, with the Next method being used to fetch the next record in the answer stream. Note also that a looping structure would be unnecessary if the code were calling a singleton select.
Calling a Stored Procedure to Perform an INSERT, UPDATE, or DELETE Operation
As mentioned earlier, a Delphi StoredProc object must be used for SQL operations that do not return an answer set, i.e. the result of a SELECT statement. Therefore, they're used to call stored procedures that contain INSERT, UPDATE, and DELETE statements.
From a Delphi standpoint, these three statements are handled the same, so we'll look at just one - an UPDATE. The Object Pascal code in Figure 9 calls a stored procedure that contains the UPDATE statement from Figure 5.
var
StoredProcPenalty: TStoredProc;
{...}
StoredProcPenalty := TStoredProc.Create(Self);
with StoredProcPenalty do
begin
DatabaseName := 'cmis_db';
StoredProcName := 'SPU_Penalty';
Prepare;
ParamByName('PenaltyID').AsInteger := PenaltyPenaltyID;
ParamByName('PartyID').AsInteger := PenaltyPartyID;
ParamByName('PenaltyType').AsString :=
ComboBoxPenaltyType.Text;
ParamByName('PenaltyUnitType').AsString :=
ComboBoxPenaltyUnits.Text;
ParamByName('DateOfPenalty').AsDate :=
StrToDate(MaskEditPenaltyDate.Text);
ParamByName('PenaltyUnits').AsInteger :=
StrToInt(MaskEditPenalty.Text);
ExecProc;
Free;
end;
Figure 9: Executing a stored procedure that contains an INSERT statement.
There are some similarities: A StoredProc object is instantiated in the same way as a Query object, and its Database property must also be assigned.
After that, however, the similarities disappear. The StoredProcName property must be assigned the name of the stored procedure - in this case, SPU_Penalty. Also, the Prepare method must be used to tell the server to get the stored procedure ready to accept input, and otherwise prepare for execution. Note also that the ExecProc method is used instead of Open (just as it is when TQuery objects return no value).
After Prepare has been called, the parameters can be assigned just as they are with Query objects - using the ParamByName method. Finally, the ExecProc method is used to execute the stored procedure (again, in lieu of the Query Open method, because no value is returned).
Conclusion
We've examined real-world examples of how to use InterBase stored procedures to develop a client/server application with Delphi. Along the way, we've covered the basics of InterBase trigger and procedure language, and - among other things - learned how to build select procedures, and how to call stored procedures from Delphi.
Another benefit of learning InterBase trigger and procedure language is that it's very much like the procedural languages used by other database vendors (Oracle's PL/SQL, for example), so once you've mastered the InterBase flavor, you'll make short work of the next.
Creating Them and Using Them from Delphi
Answer:
One of the cornerstones of successful client/server programming is the stored procedure. Unfortunately, InterBase stored procedures are woefully underdocumented, especially regarding the Delphi connection. This article attempts to help fill the documentation gap.
This article has two major goals. The first is to provide a general description of an InterBase stored procedure, describe the benefits of stored procedures, and provide specific examples of the more common procedures you'll need to create. The second is to explain how Delphi uses the stored procedures, i.e. explain how they're called.
What Is a Stored Procedure?
A stored procedure is a routine written in InterBase trigger and procedure language (catchy, hunh?) that can be called by a client (e.g. a Delphi application) or another procedure or trigger. Stored procedures can be used for many things, but this article will focus on their use with the mainstay SQL statements: SELECT, INSERT, UPDATE, and DELETE.
Select statements are the most common, so let's tackle them first. A stored procedure that contains a SQL SELECT statement is often referred to as a select procedure.
Stored Procedure Basics
An InterBase stored procedure is created using a CREATE PROCEDURE statement. The code in Figure 1, for example, creates a select procedure named SPS_Address_ProviderID. This straightforward select procedure returns four columns from any Address table row that has a ProviderID column value equal to the ProviderID provided as an input argument.
CREATE PROCEDURE SPS_Address_ProviderID(ProviderID INTEGER)
RETURNS (Address CHAR(60),
City CHAR(30),
State CHAR( 2),
ZipCode CHAR( 5))
AS
BEGIN
FOR
SELECT Address, City, State, ZipCode
FROM Address
WHERE ProviderID = :ProviderID
INTO :Address, :City, :State, :ZipCode
DO SUSPEND;
END
Figure 1: An example of a select procedure.
As you can see, a select procedure is essentially a SQL SELECT statement in the form of a function call. Input parameters - if there are any - are included in the CREATE statement as a comma-delimited list within parentheses. There's only one in this example; it's named ProviderID, and is of type INTEGER. The InterBase data types are shown in Figure 2.
Name
Size
Range/Precision
BLOB
variable
None - BLOB segment size is limited to 64KB
CHAR(n)
n characters
1 to 32767 bytes
DATE
64 bits
1 Jan 100 to 11 Dec 5941
DECIMAL(precision, scale)
variable
precision = 1 to 15, least number of precision digits
scale = 1 to 15, number of decimal places
DOUBLE PRECISION
64 bits
1.7 x 10-308 to 1.7 x 10308
FLOAT
32 bits
3.4 x 10-38 to 3.4 x 1038
INTEGER
32 bits
-2,147,483,648 to 2,147,483,648
NUMERIC(precision, scale)
variable
same as DECIMAL
SMALLINT
16 bits
-32768 to 32767
VARCHAR(n)
n characters
1 to 32765 bytes
Figure 2: InterBase data types (based on a chart from the InterBase Workgroup Server Data Definition Guide, pages 46-7).
Any output parameters - and there must be at least one for a select procedure - are described in a RETURNS statement, which also takes the form of a comma-delimited list inside parentheses. In this example, there are four output parameters: Address, City, State, and ZipCode. All are of type CHAR, which is used for strings.
Header and body. The CREATE and RETURNS statements (if RETURNS is present) comprise the stored procedure's header. Everything following the AS keyword is the procedure's body. In this example, the body is contained entirely within the BEGIN and END statements required for every stored procedure.
There can also be statements between the AS and BEGIN keywords that are considered part of the body. These statements declare local variables for the stored procedure; we'll discuss them later, along with the FOR, INTO, and DO SUSPEND statements.
Why Use Them?
They're fast. A query stored on the server as a procedure executes far more quickly than one built and executed on the client. The speed difference is even more pronounced when your database application is running on a LAN or WAN. The main reason is that when the client application sends the query to the server, the server responds with a large amount of metadata (specific database information about the requested query). The query plan is then built, and the query is re-sent to the server for execution.
In contrast, if a stored procedure is used to perform the SQL statement, the client simply requests that the server execute the procedure, and send back the answer set (if any). The result is that just two trips are made between the client and server, instead of four (one of which contains a large amount of data).
They're reusable. In a database application of significant size, you'll find yourself using the same SQL statements (SELECTs, INSERTs, etc.) repeatedly. Rather than recreate a statement on the client each time, it's better to store the statement in the database and call it. It's the same idea as maintaining a library of procedures and functions shared between modules. The benefits are the same, as well: Readability is enhanced, and redundancy, maintenance, and documentation are greatly reduced.
They're part of the database. Although this has been mentioned, it bears repeating that a stored procedure is part of the database. Not only does this make the procedure readily accessible to the database, it also insures that the procedure is syntactically correct, and that the SQL statements included in the procedure are correct. The database will not accept it until it's valid, i.e. the CREATE PROCEDURE statement will fail.
Creating Select Procedures
We'll examine five types of stored procedures:
a SELECT statement that may return multiple rows
a SELECT statement that returns one row, i.e. a singleton select
an INSERT statement
an UPDATE statement
a DELETE statement
Creating a Multi-Row SELECT
When a SELECT statement might return multiple rows, the stored procedure must use the FOR...DO looping construct. We've already seen this in Figure 1:
FOR
SELECT Address, City, State, ZipCode
FROM Address
WHERE ProviderID = :ProviderID
INTO :Address, :City, :State, :ZipCode
DO SUSPEND;
Here a FOR...DO loop has been placed around the SELECT statement. This will cause the SUSPEND command to be executed for each row returned by the SELECT statement. (SQL programmers will recognize this as a fetch loop on an open cursor.)
Fine - but what does SUSPEND do? It's got a lousy name, but a SUSPEND command is absolutely necessary to make the SELECT stored procedure work. It causes the stored procedure to return a value via the variables associated with the INTO clause. (Note: InterBase will accept a stored procedure without a SUSPEND statement, but the stored procedure will never return a value.)
Loading the Output Variables. An additional clause on the SELECT statement may be new to you. The INTO clause describes the variables that will be loaded with the result of the SELECT statement, then returned by the stored procedure via the variables described in the RETURNS statement. They must agree in number, order, and name, or InterBase will not accept the procedure.
A Singleton SELECT
When a SELECT statement will return only one row, there's no need for a FOR...DO loop (see Figure 3). However, it's important to ensure that the SELECT will never attempt to return more than one row, i.e. that the WHERE clause uses a unique row identifier. If InterBase determines that multiple rows are possible, it will not accept the procedure.
SET TERM ^ ;
CONNECT "c:\doj\cmis\cmis.gdb"^
CREATE PROCEDURE SPS_Subject_Confidential(
ProviderID INTEGER)
RETURNS (ConfideCount INTEGER)
AS
BEGIN
SELECT COUNT(*)
FROM Party P, CaseStatus CS, Status S
WHERE P.ProviderID = :ProviderID
AND CS.ComplaintID = P.ComplaintID
AND CS.Status = S.Status
AND S.ConfidentialityFlag = 'T'
AND CS.StatusDate =
( SELECT MAX(StatusDate)
FROM CaseStatus Case
WHERE Case.ComplaintID = P.ComplaintID )
INTO :ConfideCount;
SUSPEND;
END^
SET TERM ; ^
Figure 3: This ISQL script creates a singleton select. This COUNT statement will always return one row, so there is no need for the FOR...DO loop.
The SELECT statement in Figure 3 is returning the result of the aggregate function, COUNT, so it will always return one row. (Incidentally, it also features a sub-select. This type of query is useful in any situation where you need to determine the current status row for something - a "case" in this instance.)
The SELECT statement now requires a terminating semicolon:
INTO :ConfideCount;
as does the one-word SUSPEND statement that immediately follows it.
This is in contrast to the stored procedure shown in Figure 1. It may seem odd, but in the multiple SELECT shown in Figure 1, there's only one statement in the body of the procedure: It's a FOR...DO statement that's terminated just after the SUSPEND command:
DO SUSPEND;
Therefore, there is no terminating semicolon for the SELECT itself.
An INSERT
An INSERT statement is used to add a row to an InterBase table. No RETURNS variable is necessary for an INSERT stored procedure (see Figure 4). Not shown is that an InterBase trigger is using a generator to automatically assign a value to a primary key column - a typical scenario. (These issues are discussed in detail in Bill Todd's article, "InterBase Triggers and Generators.")
SET TERM ^ ;
CONNECT "c:\doj\cmis\cmis.gdb"^
CREATE PROCEDURE SPI_Payment
(
MoneyOwedBMCFID INTEGER,
AmountPaid FLOAT,
CheckNumber CHAR(15),
DateOfCheck DATE,
DateMoneyReceived DATE,
DateMoneyDistributed DATE
)
AS
BEGIN
INSERT INTO Payments
(
MoneyOwedBMCFID,
AmountPaid,
CheckNumber,
DateOfCheck,
DateMoneyReceived,
DateMoneyDistributed
)
VALUES
(
:MoneyOwedBMCFID,
:AmountPaid,
:CheckNumber,
:DateOfCheck,
:DateMoneyReceived,
:DateMoneyDistributed
);
END^
SET TERM ; ^
Figure 4: This stored procedure describes a SQL INSERT statement.
An UPDATE
An UPDATE statement is used to modify one or multiple columns of an existing row in an InterBase table. No RETURNS variable is necessary for an UPDATE stored procedure (see Figure 5). However, one or more of the input arguments must be used in a WHERE clause to identify the row to update.
SET TERM ^ ;
CONNECT "c:\doj\cmis\cmis.gdb"^
CREATE PROCEDURE SPU_Penalty
(
PenaltyID INTEGER,
PartyID INTEGER,
PenaltyType CHAR(20),
PenaltyUnitType CHAR(10),
DateOfPenalty DATE,
PenaltyUnits INTEGER
)
AS
BEGIN
UPDATE Penalty
SET PartyID
WHERE PenaltyID = :PenaltyID; = :PartyID,
PenaltyType = :PenaltyType,
PenaltyUnitType = :PenaltyUnitType,
DateOfPenalty = :DateOfPenalty,
PenaltyUnits = :PenaltyUnits
END^
SET TERM ; ^
Figure 5: This stored procedure describes a SQL UPDATE statement.
A DELETE
A DELETE statement is used to remove an existing row or rows from an InterBase table. No RETURNS variable is necessary for a DELETE stored procedure (see Figure 6). One or more of the input arguments must be used in a WHERE clause to identify the row(s) to delete.
SET TERM ^ ;
CONNECT "c:\doj\cmis\cmis.gdb"^
CREATE PROCEDURE SPD_LicenseToBill (ProviderID INTEGER)
AS
BEGIN
DELETE FROM LicenseToBill
WHERE ProviderID = :ProviderID;
END^
SET TERM ; ^
Figure 6: This stored procedure describes a SQL DELETE statement.
ISQL Scripts
To add a stored procedure to an InterBase database, you must describe the stored procedure in an ISQL script and then run that script using ISQL. The code examples presented so far are ISQL scripts that must be run through InterBase's interactive interface, ISQL (using the menu command File | Run an ISQL Script). A couple of tricks are required to make these scripts work.
First, although you may already have connected to an InterBase database using ISQL (File | Connect to Database), it is still necessary to explicitly connect each time an ISQL script is executed. This is done with a CONNECT statement; for example:
CONNECT "c:\doj\cmis\cmis.gdb"^
The trouble with terminators. Second, an ISQL script must satisfy two masters: the ISQL tool itself, and the InterBase database it addresses. Both require statement terminators, and both use the semicolon (; ) as their default terminator character. Something's gotta give, so you need to temporarily change the terminator for ISQL. This is done with the SET TERM command. This statement, for example:
SET TERM ^ ;
tells ISQL to use the carat (^ ) character as a terminator until further notice. You can use any character you like as the alternate terminator, but I would highly recommend that you use something unusual. Typically, the last statement in an ISQL script replaces the semicolon as the terminating character.
Calling Stored Procedures from Delphi
Okay, we know how to build the stored procedures. Now how do we call them from Delphi? There are two ways - one is necessary for SELECT statements (i.e. statements that return a value), the other for INSERT, UPDATE, and DELETE statements.
Stored procedures with SELECT statements are called from Delphi using a Query object (of class TQuery). This is despite the fact that we're calling a stored procedure; again, a Delphi Query object is used for any statement that returns the result of a SELECT statement. The other SQL statements - INSERT, UPDATE, and DELETE - are called using a Delphi StoredProc object (of class TStoredProc).
Calling a Select Procedure
We'll describe how stored procedures are called, beginning with a SELECT statement. First, however, let's back up a bit and take a look at how we'd describe and call a "conventional" query (i.e. one not contained in a select procedure) using Object Pascal (see Figure 7).
procedure {... }
var
FetchCount: Word;
QueryAddress: TQuery;
{ ... }
QueryAddress := TQuery.Create(Self);
with QueryAddress do
begin
DatabaseName := 'CMIS_DB';
SQL.Add('SELECT AddressType, Address, City, County, ');
SQL.Add(' State, ZipCode, ZipPlus4, PhoneNumber');
SQL.Add(' FROM Address ');
SQL.Add(' WHERE ProviderID = :ProviderID ');
ParamByName('ProviderID').AsInteger :=
SubjectUpdateProviderID;
Open;
FetchCount := 0;
while EOF = False do
begin
with StringGridAddress do
begin
RowCount := FetchCount + 1;
Cells[0, FetchCount] := Fields[0].Text;
Cells[1, FetchCount] := Fields[1].Text;
Cells[2, FetchCount] := Fields[2].Text;
Cells[3, FetchCount] := Fields[3].Text;
Cells[4, FetchCount] := Fields[4].Text;
Cells[5, FetchCount] := Fields[5].Text;
Cells[6, FetchCount] := Fields[6].Text;
Cells[7, FetchCount] := Fields[7].Text;
end;
Inc(FetchCount);
Next;
end;
Free;
end;
{ ... }
end;
Figure 7: Describing and executing a SQL SELECT statement with Object Pascal.
First the Query object, QueryAddress, is instantiated, and its Database and SQL properties are assigned values. Then the single query parameter, ProviderID, is assigned a value, and the query is executed using the Open method. In this example, a while loop is used to take the results of the query and load them into a StringGrid component.
All of this is familiar, but how do we change it to call a stored procedure? For this SELECT statement, the changes are fairly minor (see Figure 8). There are two notable differences:
First, the FROM clause now refers to the name of the stored procedure, SPS_Address_ProviderID, not a specific table. (The difference would be more pronounced if there were a list of tables.)
Second, there is no WHERE clause; the WHERE clause is described in the stored procedure. The input parameter is simply placed in parentheses following the FROM clause. (Again, the difference would have been more pronounced if there had been an elaborate WHERE clause.)
var
FetchCount: Word;
QueryAddress: TQuery;
{ ... }
QueryAddress := TQuery.Create(Self);
with QueryAddress do
begin
DatabaseName := 'CMIS_DB';
SQL.Add('SELECT AddressType, Address, City, County, ');
SQL.Add(' State, ZipCode, ZipPlus4, PhoneNumber');
SQL.Add(' FROM SPS_Address_ProviderID (:ProviderID) ');
ParamByName('ProviderID').AsInteger :=
SubjectUpdateProviderID;
Open;
FetchCount := 0;
while EOF = False do
begin
with StringGridAddress do
begin
RowCount := FetchCount + 1;
Cells[0, FetchCount] := Fields[0].Text;
Cells[1, FetchCount] := Fields[1].Text;
Cells[2, FetchCount] := Fields[2].Text;
Cells[3, FetchCount] := Fields[3].Text;
Cells[4, FetchCount] := Fields[4].Text;
Cells[5, FetchCount] := Fields[5].Text;
Cells[6, FetchCount] := Fields[6].Text;
Cells[7, FetchCount] := Fields[7].Text;
end;
Inc(FetchCount);
Next;
end;
Free;
end;
Figure 8: Executing an InterBase select procedure from Object Pascal.
The rest of the procedure is the same: Multiple rows are being loaded into a StringGrid, with the Next method being used to fetch the next record in the answer stream. Note also that a looping structure would be unnecessary if the code were calling a singleton select.
Calling a Stored Procedure to Perform an INSERT, UPDATE, or DELETE Operation
As mentioned earlier, a Delphi StoredProc object must be used for SQL operations that do not return an answer set, i.e. the result of a SELECT statement. Therefore, they're used to call stored procedures that contain INSERT, UPDATE, and DELETE statements.
From a Delphi standpoint, these three statements are handled the same, so we'll look at just one - an UPDATE. The Object Pascal code in Figure 9 calls a stored procedure that contains the UPDATE statement from Figure 5.
var
StoredProcPenalty: TStoredProc;
{...}
StoredProcPenalty := TStoredProc.Create(Self);
with StoredProcPenalty do
begin
DatabaseName := 'cmis_db';
StoredProcName := 'SPU_Penalty';
Prepare;
ParamByName('PenaltyID').AsInteger := PenaltyPenaltyID;
ParamByName('PartyID').AsInteger := PenaltyPartyID;
ParamByName('PenaltyType').AsString :=
ComboBoxPenaltyType.Text;
ParamByName('PenaltyUnitType').AsString :=
ComboBoxPenaltyUnits.Text;
ParamByName('DateOfPenalty').AsDate :=
StrToDate(MaskEditPenaltyDate.Text);
ParamByName('PenaltyUnits').AsInteger :=
StrToInt(MaskEditPenalty.Text);
ExecProc;
Free;
end;
Figure 9: Executing a stored procedure that contains an INSERT statement.
There are some similarities: A StoredProc object is instantiated in the same way as a Query object, and its Database property must also be assigned.
After that, however, the similarities disappear. The StoredProcName property must be assigned the name of the stored procedure - in this case, SPU_Penalty. Also, the Prepare method must be used to tell the server to get the stored procedure ready to accept input, and otherwise prepare for execution. Note also that the ExecProc method is used instead of Open (just as it is when TQuery objects return no value).
After Prepare has been called, the parameters can be assigned just as they are with Query objects - using the ParamByName method. Finally, the ExecProc method is used to execute the stored procedure (again, in lieu of the Query Open method, because no value is returned).
Conclusion
We've examined real-world examples of how to use InterBase stored procedures to develop a client/server application with Delphi. Along the way, we've covered the basics of InterBase trigger and procedure language, and - among other things - learned how to build select procedures, and how to call stored procedures from Delphi.
Another benefit of learning InterBase trigger and procedure language is that it's very much like the procedural languages used by other database vendors (Oracle's PL/SQL, for example), so once you've mastered the InterBase flavor, you'll make short work of the next.
Feliratkozás:
Bejegyzések (Atom)