Pascal Newsletter #6
INDEX
1. A FEW WORDS FROM THE EDITOR
2. FREE BORLAND TOOLS
3. SCANNING COMPRESSED ARCHIVES
4. THE NEWBIE & THE PRO
Boolean constants, variables and expressions
________________________________________________________________________
1. A FEW WORDS FROM THE EDITOR
Soon we will be sending all our subscribers a questionnaire by email.
This questionnaire will help us evaluate this newsletter and see what we
can do to better suit your needs. It is very important that you answer
the questions and return it to make your opinion count in the definition
of how the future editions will be. Answering will be fairly fast and
easy since most questions will have a set of predefined answers for you
to choose. We would appreciate it very much if you could take the time
to participate in this poll. Thanks in advance.
Regards,
Ernesto De Spirito
eds2008 @ latiumsoftware.com
________________________________________________________________________
JfControls Library. Multi-language. Multi-appearance. Skins. Privileges.
More than 40 integrated and customizable components. Impressive GUI.
Centralized resources administration. Multiple programming problems
solved. For Delphi 3-2006 & C++ Builder 3-6. http://www.jfactivesoft.com
________________________________________________________________________
2. FREE BORLAND TOOLS
A couple of months ago Borland released the Borland C/C++ 5.5 compiler
as freeware, a 32-bit command-line version of the compiler used by C++
Builder, and it comes with other command-line utilities (preprocessor,
linker, resource compiler and linker, librarian and other stuff), help
(restricted only to the operation of the tools), include and library
files and some some examples, but of course it doesn't include the VCL
and the C++ reference. If you are interested in downloading it, you can
find it here:
http://www.borland.com/bcppbuilder/freecompiler/ (7.79 Mb)
More recently Borland released Turbo Debugger as freeware, and I don't
have to tell you how much you would need this tool to find out what goes
wrong with your programs!
http://www.borland.com/bcppbuilder/turbodebugger/ (590 Kb)
You won't go to the moon with these tools, but you can borrow an old
C/C++ book and learn a little C if you like. ;)
________________________________________________________________________
3. SCANNING COMPRESSED ARCHIVES
In the last issue we introduced the TZipMaster component and the Zip/
Unzip DLLs (ZIPDLL.DLL and UNZDLL.DLL). As we promised, in this issue we
will use this component to enable our Find File application to search
for files inside compressed archives.
To follow the steps you need to have the last version of Find File. If
you are new to this newsletter or if you haven't been following it
lately, you can download if from here:
http://www.latiumsoftware.com/en/file.php?id=p04
You also need to have the TZipMaster component and the DLLs correctly
installed. Instructions can be found in the last newsletter:
http://www.latiumsoftware.com/en/pascal/0005.php
Well, enough introduction. Let's work. BTW, just in case you wonder ;)
some new or modified lines are marked with an asterisk ("*"), and the
ellipsis ("...") means the rest is the same.
1) We included the ZipMaster messages resource file in the program file:
program FindFile;
uses
...
{$R *.RES}
* {$R ZipMsgUS.RES}
begin
...
We also added one extra message in the main form:
{$IFDEF Spanish}
...
* cstrFileExists = '"%s" ya existe. ¿Sobreescribir?';
{$ELSE}
...
* cstrFileExists = '"%s" already exists. Overwrite?';
{$ENDIF}
This is the message we will show the user when we have to decompress a
file in the temporal directory and there already exists a file with the
same name.
2) We defined some new functions in the Common unit.
unit Common;
interface
* uses classes, windows;
...
* function FileNameMatchesFilespec(const FileName, Filespec: string):
* boolean;
* function GetAssociatedSmallIcon(const FileName: string): HICON;
* function GetTempDir: string;
* function GetWindowsDir: string;
* function GetSystemDir: string;
implementation
* uses sysutils, registry, shellapi, filectrl;
...
// ===================================================================
function FileNameMatchesFilespec(const FileName, Filespec: string):
boolean;
// Returns True if the FileName (for example 'RESUME.DOC') matches a
// file specification (for example 'R*.DO?').
var
WName, WExt, FName, FExt: string;
// -------------
function ExpressionMatch(const s1, s2: string): boolean;
var
i, n, n1, n2: integer;
p1, p2: pchar;
begin
n1 := Length(s1);
n2 := Length(s2);
if n1 < n2 then n := n1 else n := n2;
p1 := pchar(s1);
p2 := pchar(s2);
for i := 1 to n do begin
if p2^ = '*' then begin
Result := True;
exit;
end;
if (p2^ <> '?') and (p2^ <> p1^) then begin
Result := False;
exit;
end;
inc(p1); inc(p2);
end;
if n1 = n2 then
Result := True
else if n1 > n2 then
Result := False
else begin // n1 < n2
for i := n1 + 1 to n2 do begin
if (p2^ <> '*') and (p2 <> '?') then begin
Result := False;
exit;
end;
inc(p2);
end;
Result := True;
end;
end;
// -------------
begin
WName := AnsiUpperCase(ExtractFileName(Filespec));
WExt := ExtractFileExt(WName);
WName := Copy(WName, 1, Length(WName) - Length(WExt));
FName := AnsiUpperCase(ExtractFileName(FileName));
FExt := ExtractFileExt(FName);
FName := Copy(FName, 1, Length(FName) - Length(FExt));
if WName = '' then WName := '*';
if WExt = '' then WExt := '.*';
if FExt = '' then FExt := '.';
Result := ExpressionMatch(FName, WName) and ExpressionMatch(FExt,
WExt);
end;
// ===================================================================
function RCPos(c: char; const s: string): integer;
// Returns the position of the rightmost occurrence of a character
// in a string
var
i: integer;
p: pchar;
begin
i := Length(s);
p := pchar(s) + i - 1;
for i := i downto 1 do begin
if p^ = c then begin
Result := i;
exit;
end;
dec(p);
end;
Result := 0;
end;
// ===================================================================
function GetTempDir: string;
// Returns Windows's temporal directory
var
TmpDir: array [0..MAX_PATH-1] of char;
begin
SetString(Result, TmpDir, GetTempPath(MAX_PATH, TmpDir));
Result := ExcludeTrailingBackslash(Result);
if not DirectoryExists(Result) then begin
Result := GetWindowsDir + '\TEMP';
if not DirectoryExists(Result) then
try MkDir(Result);
except
Result := ExtractFileDrive(Result) + '\TEMP';
if not DirectoryExists(Result) then
try MkDir(Result);
except
Result := ExtractFileDrive(Result) + '\TMP';
if not DirectoryExists(Result) then
try MkDir(Result);
except
Result := '';
end;
end;
end;
end;
end;
// ===================================================================
function GetWindowsDir: string;
// Returns Windows's directory
var
WinDir: array [0..MAX_PATH-1] of char;
begin
SetString(Result, WinDir, GetWindowsDirectory(WinDir, MAX_PATH));
end;
// ===================================================================
function GetSystemDir: string;
// Returns Windows's System directory
var
SysDir: array [0..MAX_PATH-1] of char;
begin
SetString(Result, SysDir, GetSystemDirectory(SysDir, MAX_PATH));
end;
// ===================================================================
function GetAssociatedSmallIcon(const FileName: string): HICON;
// Returns the small icon of a given file or document, whether
// it actually exists on the disk or not.
var
IconIndex: word;
SmallIconHandle: HIcon;
FileExt, FileType, IconSource: String;
p: integer;
Reg: TRegistry;
PLargeIconHandle: ^HIcon;
begin
FileExt := UpperCase(ExtractFileExt(FileName));
IconIndex := 0;
if ((FileExt = '.EXE') or (FileExt = '.ICO')) and
FileExists(FileName) then begin
IconSource := FileName;
end else begin
if FileExt = '.EXE' then FileExt := '.COM';
FileType := '';
IconSource := '';
Reg := TRegistry.Create(KEY_QUERY_VALUE);
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.OpenKeyReadOnly(FileExt) then begin
FileType := Reg.ReadString('');
Reg.CloseKey;
end; // if
if FileType <> '' then begin
if Reg.OpenKeyReadOnly(FileType + '\DefaultIcon')
then begin
IconSource := Reg.ReadString('');
Reg.CloseKey;
end;
end;
Reg.Free;
if IconSource = '' then begin
IconSource := GetSystemDir + '\SHELL32.DLL';
if FileExt = '.DLL' then IconIndex := 66;
end else begin
p := RCPos(',', IconSource);
if p <> 0 then begin
IconIndex := StrToInt(Copy(IconSource, p + 1,
Length(IconSource) - p));
IconSource := Copy(IconSource, 1, p - 1);
end;
end;
end;
PLargeIconHandle := nil;
if ExtractIconEx(pchar(IconSource), IconIndex,
PLargeIconHandle^, SmallIconHandle, 1) <> 1 then begin
IconSource := GetSystemDir + '\SHELL32.DLL';
if FileExt = '.EXE' then IconIndex := 2
else if FileExt = '.COM' then IconIndex := 2
else if FileExt = '.INI' then IconIndex := 63
else if FileExt = '.INF' then IconIndex := 63
else if FileExt = '.BAT' then IconIndex := 65
else if FileExt = '.DLL' then IconIndex := 66
else IconIndex := 0;
if ExtractIconEx(pchar(IconSource), IconIndex,
PLargeIconHandle^, SmallIconHandle, 1) <> 1 then
Result := 0
else
Result := SmallIconHandle;
end else
Result := SmallIconHandle;
end;
// ===================================================================
end.
3) We added two ZipMaster components to the form and named them Zip1 and
Zip2. We will use one for the search thread and the other to decompress
a file in the temporal directory when the user double-clicks on it, so
we can open the file with its associated application.
4) We added a CheckBox so the users can specify whether they want to
scan inside Zip archives or not. We named it "chkScanZIPs" and labeled
it "Scan ZIP archives". We added code to disable and enable this new
CheckBox when appropriate:
procedure TForm1.Button1Click(Sender: TObject);
var
c: char;
begin
...
Checkbox1.Enabled := False;
* chkScanZIPs.Enabled := False;
Button2.Enabled := True;
...
end;
procedure TForm1.Thread1Done(var AMessage: TMessage);
begin
...
Checkbox1.Enabled := True;
* chkScanZIPs.Enabled := True;
...
end;
5) We added code in TThread1.Execute to load the Unzip DLL (if needed)
before the search.
begin // procedure TThread1.Execute;
Count := 0;
Synchronize(Initialize);
Keywords := TStringList.Create;
GetKeywords(Keywords, OwnerForm.Edit2.Text);
n := Keywords.Count - 1;
for i := 0 to n do
Keywords[i] := UpperCase(Keywords[i]);
* if OwnerForm.chkScanZIPs.Checked then
* OwnerForm.Zip1.Load_Unz_Dll;
ScanFolder(OwnerForm.Edit3.Text);
Keywords.Free;
Synchronize(Finalize);
end;
Load_Unz_Dll will do nothing if the DLL is already loaded. The DLL will
be automatically downloaded when the component is destroyed (it will
happen when the form is destroyed).
6) We added a conditional block in the to ScanFolder procedure to avoid
loading and scanning ZIP archives since they are not like ordinary
files and we will handle them separately. We also added a line to free
the memory taken by the "Content" string once we don't need it anymore.
procedure ScanFolder(const folder: string);
var
SearchRec: TSearchRec;
i: integer;
begin
if FindFirst(folder + OwnerForm.Edit1.Text,
faReadOnly Or faHidden Or faSysFile Or faArchive,
SearchRec) = 0 then begin
Location := folder;
repeat
try
FileName := SearchRec.Name;
* if UpperCase(ExtractFileExt(FileName)) <> '.ZIP' then begin
Content := UpperCase(LoadFile(folder + FileName));
Score := 0;
for i := 0 to n do
if Pos(Keywords[i], Content) <> 0 then inc(Score);
* Content := ''; // Free the memory
if Score > 0 then begin
inc(Count);
Time := FileDateToDateTime(SearchRec.Time);
Synchronize(AddFileName);
end; // if
* end; // if
except
end; // try
until Terminated Or (FindNext(SearchRec) <> 0);
end; // if
FindClose(SearchRec);
7) We added the following code right after the one we've just reproduced
above:
if OwnerForm.chkScanZIPs.Checked then begin
if FindFirst(folder + '*.ZIP', faReadOnly Or faHidden Or faSysFile
Or faArchive, SearchRec) = 0 then begin
repeat
try
ScanZip(folder + SearchRec.Name);
except
end; // try
until Terminated Or (FindNext(SearchRec) <> 0);
end; // if
FindClose(SearchRec);
end;
This code searches for all the .ZIP files in the directory (referenced
by the variable "folder") and calls ScanZip to process them.
8) We defined the ScanZip procedure inside the TThread1.Execute
procedure, right before ScanFolder.
procedure TThread1.Execute;
var
...
// -------------------------------------
procedure ScanZip(const ZipName: string);
var
i, j: integer;
PZipDirEntry: ^ZipDirEntry;
ZipStream: TZipStream;
begin
OwnerForm.Zip1.ZipFileName := ZipName;
for j := 0 to OwnerForm.Zip1.Count - 1 do begin
try
PZipDirEntry := OwnerForm.Zip1.ZipContents[j];
if UpperCase(ExtractFileExt(PZipDirEntry.FileName)) = '.ZIP'
then begin
// A Zip inside a Zip. Skip it.
end else if PZipDirEntry.UncompressedSize > 0 then begin
FileName := ExtractFileName(PZipDirEntry.FileName);
if FileNameMatchesFilespec(FileName, OwnerForm.Edit1.Text)
then begin
ZipStream := OwnerForm.Zip1.ExtractFileToStream(
PZipDirEntry.FileName);
SetString(Content, PChar(ZipStream.Memory), ZipStream.Size);
ZipStream.Clear;
Content := UpperCase(Content);
Score := 0;
for i := 0 to n do
if Pos(Keywords[i], Content) <> 0 then inc(Score);
Content := ''; // Free the memory
if Score > 0 then begin
inc(Count);
Location := ZipName + '?'
+ ExtractFilePath(PZipDirEntry.FileName);
Time := FileDateToDateTime(PZipDirEntry.DateTime);
Synchronize(AddFileName);
end; // if
end; // if
end;
finally
end;
if Terminated then break;
end; // for j
end;
// -------------------------------------
procedure ScanFolder(const folder: string);
...
What this procedure does is first open the ZIP and then process all its
files in a for..do loop. If the file inside the archive is a ZIP file or
if its length is 0, or if it doesn't match the file specification, it is
simply ignored.
We decided to decompress the files in memory, using the
ExtractFileToStream method that returns a Stream (a descendant of
TMemoryStream to be precise). Then we put the contents of this stream in
a string and we search the keywords as we did with normal files once
they were loaded in a string. If we find a match, instead of just the
directory, we will set "Location" to the full path name of the ZIP
archive plus a question mark (to signal it's a ZIP file) and the
relative path of the file inside the archive. For example
C:\ZIPARCH.ZIP?VCL\ means the location of the file is the VCL directory
inside the archive C:\ZIPARCH.ZIP.
9) The API ExtractIcon only works with files that are on disk, but now
this won't be always true since some files will be inside an archive, so
we modified TThread1.AddFileName to use the GetAssociatedSmallIcon
function that we had written in the Common unit.
procedure TThread1.AddFileName; // Synchronized
var
* ListItem: TListItem;
* Icon: TIcon;
* IconHandle: HIcon;
begin
...
ListItem.Caption := FileName;
* IconHandle := GetAssociatedSmallIcon(Location + FileName);
* Icon := TIcon.Create;
* if IconHandle <> 0 then Icon.Handle := IconHandle;
* ListItem.ImageIndex := OwnerForm.ImageList1.AddIcon(Icon);
* Icon.Free;
ListItem.SubItems.Add(Location);
...
end;
10) We edited the Items property of PopupMenu1 and we added a new item
named OpenArchive1, we labeled it "Open Archive" (Caption property), and
then we generated its Click event:
* procedure TForm1.OpenArchive1Click(Sender: TObject);
* begin
* OpenArchive(SelectedItem);
* end;
OpenArchive is a new method we declared in the private declarations of
the form, along with other new methods:
TForm1 = class(TForm)
...
private
{ Private declarations }
...
* procedure ExecuteAssociation(const FileName: string);
* procedure OpenFolder(ListItem: TListItem);
* procedure OpenFile(ListItem: TListItem);
* procedure OpenArchive(ListItem: TListItem);
public
{ Public declarations }
end;
We defined these methods in the implementation section as follows:
procedure TForm1.ExecuteAssociation(const FileName: string);
begin
if ShellExecute(Self.Handle, nil, PChar(FileName),
nil, nil, SW_SHOWMAXIMIZED) <= 32 then
Application.MessageBox(cstrCouldNotExecApp,
'Error', MB_ICONEXCLAMATION);
end;
// -------------------------------------------------------------------
procedure TForm1.OpenFolder(ListItem: TListItem);
var
p: integer;
Folder: string;
begin
Folder := ListItem.SubItems.Strings[0];
p := Pos('?', Folder);
if p <> 0 then begin
SetLength(Folder, p-1);
Folder := ExtractFilePath(Folder);
end;
ExecuteAssociation(Folder);
end;
// -------------------------------------------------------------------
procedure TForm1.OpenFile(ListItem: TListItem);
var
p: integer;
Folder, FileName, CurrentDir: string;
begin
Folder := ListItem.SubItems.Strings[0];
p := Pos('?', Folder);
if p = 0 then
FileName := Folder + ListItem.Caption
else begin // Compressed file
FileName := GetTempDir + '\' + ListItem.Caption;
if FileExists(FileName) then
if Application.MessageBox(PChar(Format(cstrFileExists,
[FileName])), 'Warning', MB_ICONQUESTION or MB_YESNO)
= IDNO then
exit;
Zip2.Load_Unz_Dll;
Zip2.ZipFileName := Copy(Folder, 1, p - 1);
Zip2.FSpecArgs.Add(Copy(Folder, p + 1, Length(Folder) - p)
+ ListItem.Caption);
Zip2.ExtrOptions := [ExtrOverWrite];
CurrentDir := GetCurrentDir;
ChDir(ExtractFilePath(FileName));
try
Zip2.Extract;
finally
ChDir(CurrentDir);
end;
if not FileExists(FileName) then exit;
end;
ExecuteAssociation(FileName);
end;
// -------------------------------------------------------------------
procedure TForm1.OpenArchive(ListItem: TListItem);
var
Archive: string;
begin
Archive := ListItem.SubItems.Strings[0];
SetLength(Archive, Pos('?', Archive) - 1);
ExecuteAssociation(Archive);
end;
// -------------------------------------------------------------------
11) We changed TForm1.ListView1DblClick, TForm1.Open1Click and
TForm1.OpenFolder1Click to call these new methods instead of handling
things themselves:
procedure TForm1.ListView1DblClick(Sender: TObject);
var
Col: Integer;
ListItem: TListItem;
begin
ListItem := TListViewX(ListView1).GetItemAtX(Last.X, Last.Y, Col);
* if ListItem <> nil then
* if Col = 0 then
* OpenFile(ListItem)
* else if Col = 1 then
* if Pos('?', ListItem.SubItems.Strings[0]) <> 0 then
* OpenArchive(ListItem)
* else
* OpenFolder(ListItem);
end;
...
procedure TForm1.Open1Click(Sender: TObject);
begin
* OpenFile(SelectedItem);
end;
// -------------------------------------------------------------------
procedure TForm1.OpenFolder1Click(Sender: TObject);
begin
* OpenFolder(SelectedItem);
end;
11) We changed TForm1.ListView1MouseDown and TForm1.ListView1KeyDown to
enable/disable the new menu item before invoking the context menu:
procedure TForm1.ListView1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
...
if (SelectedItem <> nil) and (Col <= 1) then begin
* PopupMenu1.Items[2].Enabled :=
* Pos('?', SelectedItem.SubItems[0]) <> 0;
* if PopupMenu1.Items[2].Enabled then
* PopupMenu1.Items[2].Default := True
* else
* PopupMenu1.Items[Col].Default := True;
PopupMenu1.Popup(
...
procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
...
if SelectedItem <> nil then begin
* PopupMenu1.Items[2].Enabled :=
* Pos('?', SelectedItem.SubItems[0]) <> 0;
PopupMenu1.Items[0].Default := True;
PopupMenu1.Popup(
...
Ok, this should be it. Now you can try to execute the example. If you
are too lazy to do all the changes by yourself, or if you have any
problems, you can download the full source code:
http://www.latiumsoftware.com/en/file.php?id=p06
________________________________________________________________________
4. THE NEWBIE & THE PRO
Boolean constants, variables and expressions
In this issue we decided to start this new section aimed at portraying
the differences in the coding styles of newbies and expert programmers.
If you have more examples like the ones below, please share them with
us so we can publish them.
We decided to begin with boolean expressions, since perhaps they mark
the most notorious differences. In the following examples, "b" is
supposed to be a boolean variable...
NEWBIE:
if a[i] = x then
b := True
else
b := False;
PRO:
b := a[i] = x;
Explanation: "a[i] = x" is a comparison expression, and as such is a
boolean expression, i.e. it evaluates to True or False, so we can
assign the result of the expression directly to our boolean variable.
For instance, if "a[i] = x" is True, this is the value that will be
assigned to "b", and if it's False, "b" will be assigned False. Right?
--------------
NEWBIE:
if a[i] = x then
b := False
else
b := True;
PRO:
b := a[i] <> x;
Explanation: This is similar to the previous example, but in this case
we reverse the comparison operator to reverse the result. For example,
if "a[i] = x" is True, "a[i] <> x" would be False, and this is the value
assigned to "b", and if "a[i] = x" is False, "a[i] <> x" would be True
and this is the value assigned to "b".
Instead of "a[i] <> x" we could have written "not (a[i] = x)", but it
makes the expression more complex since it uses one more operator, and
also a bit harder to read.
--------------
NEWBIE:
if b = True then c = '*';
PRO:
if b then c = '*';
Explanation: The "if" already evaluates if the condition is True, so you
don't have to do it.
--------------
NEWBIE:
if b = False then c = '*';
PRO:
if not b then c = '*';
Explanation: Now we need to act on the falsehood of the condition, but
instead of asking if it's False, we can reverse the condition with a
"not", so we would be asking if it's not True instead.
--------------
We have to say that in each of the examples we've just presented above,
both ways of programming are correct and in theory the Delphi compiler
is smart enough to produce identical machine code. The only difference
is that pros write less and show they understand boolean expressions...
________________________________________________________________________
YOU CAN HELP US
We need your help to keep this newsletter going and growing. You can
help by referring the newsletter to your colleagues:
http://www.latiumsoftware.com/en/pascal/delphi-newsletter.php
Or you can help by voting for us in some or all of these rankings to
give more visibility to our web site and thus increase the number of
subscriptions to this newsletter:
http://www.programmingpages.com/?r=latiumsoftwarecomenpascal
http://top100borland.com/in.php?who=20
It's just a few seconds for you that REALLY mean a lot to us.
________________________________________________________________________
If you haven't received the full source code examples for this issue,
you can get them from http://www.latiumsoftware.com/en/file.php?id=p06
________________________________________________________________________
This newsletter is provided "AS IS" without warranty of any kind. Its
use implies the acceptance of our licensing terms and disclaimer of
warranty you can read at http://www.latiumsoftware.com/en/legal.php
where you will also find a note about legal trademarks. Articles are
copyright of their respective authors and they are reproduced here with
their permission. You can redistribute this newsletter as long as you do
it in full (including copyright notices), without changes, and gratis.
________________________________________________________________________
Main page: http://www.latiumsoftware.com/en/pascal/delphi-newsletter.php
Group home page: http://groups.yahoo.com/group/pascal-newsletter/
Subscribe/join: pascal-newsletter-subscribe@yahoogroups.com
Unsubscribe/leave: pascal-newsletter-unsubscribe@yahoogroups.com
Problems with your subscription? eds2008 @ latiumsoftware.com
________________________________________________________________________
Latium Software http://www.latiumsoftware.com/en/index.php
Copyright (c) 2000 by Ernesto De Spirito. All rights reserved.
________________________________________________________________________
|
