unit uFileOpen3;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, FileCtrl, ShellAPI, ShlObj, Buttons, OLE2, ActiveX;
type
TForm1 = class(TForm)
lbFiles: TFileListBox;
lbDirectories: TDirectoryListBox;
drvcbDrives: TDriveComboBox;
btnFileProperties: TBitBtn;
btnFindFiles: TBitBtn;
btnQuit: TBitBtn;
chkbMyComputer: TCheckBox;
Label1: TLabel;
btnBrowseTo: TBitBtn;
btnSendToRecycle: TBitBtn;
procedure btnFilePropertiesClick(Sender: TObject);
procedure btnQuitClick(Sender: TObject);
procedure btnFindFilesClick(Sender: TObject);
procedure lbDirectoriesChange(Sender: TObject);
procedure drvcbDrivesChange(Sender: TObject);
procedure btnSendToRecycleClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure lbDirectoriesEnter(Sender: TObject);
procedure drvcbDrivesEnter(Sender: TObject);
procedure lbFilesEnter(Sender: TObject);
procedure btnBrowseToClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure ShowProperties(sFileName :String);
procedure SendToRecycleBin(sFileName :String);
procedure BrowseTo(sURL, sBrowser, sDir :String);
end;
var
sei : TShellExecuteInfo;
Form1: TForm1;
b : Integer;
implementation
uses ShBrowse;
const
AILeft = 1;
AIRight = 2;
AIBottom = 3;
AITop = 4;
{$R *.DFM}
procedure TForm1.btnFilePropertiesClick(Sender: TObject);
begin
case b of
0:
ShowMessage('You must select a drive, directory or file first');
1:
ShowProperties(drvcbDrives.Drive + ':');
2:
ShowProperties(lbFiles.FileName);
3:
ShowProperties(lbDirectories.Directory);
end;
end;
procedure TForm1.ShowProperties(sFileName :String);
begin
ZeroMemory(@sei, sizeof(sei));
with sei do
begin
cbSize := SizeOf(sei);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI;
Wnd := Form1.Handle;
lpVerb := 'properties';
lpFile := PChar(sFileName);
nShow := SW_SHOWNORMAL;
end;
ShellExecuteEX(@sei);
end;
procedure TForm1.btnQuitClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.btnFindFilesClick(Sender: TObject);
var
pidl: PITEMIDLIST;
begin
ZeroMemory(@sei, sizeof(sei));
with sei do
begin
cbSize := SizeOf(sei);
fMask := SEE_MASK_INVOKEIDLIST;
lpVerb := 'find';
if chkbMyComputer.Checked then
begin
SHGetSpecialFolderLocation(0,CSIDL_DRIVES,pidl);
lpIDList := pidl;
end
else
begin
case b of
0, 1:
lpFile := PChar(String(drvcbDrives.Drive) + ':');
2:
begin
ShowMessage('You can only use this on Drives and Directories');
Exit;
end;
3:
lpFile := PChar(lbDirectories.Directory);
end;
end;
end;
ShellExecuteEx(@sei);
end;
procedure TForm1.lbDirectoriesChange(Sender: TObject);
begin
lbFiles.Directory := lbDirectories.Directory;
if chkbMyComputer.Checked then
chkbMyComputer.Checked := False;
end;
procedure TForm1.drvcbDrivesChange(Sender: TObject);
begin
lbDirectories.Drive := drvcbDrives.Drive;
if chkbMyComputer.Checked then
chkbMyComputer.Checked := False;
end;
procedure TForm1.btnSendToRecycleClick(Sender: TObject);
var
s : string;
begin
case b of
0:
ShowMessage('You must select a drive, directory or file first');
1:
ShowMessage('You can only use this on Files and Directories');
2:
SendToRecycleBin(lbFiles.FileName);
3:
begin
s := lbDirectories.Directory;
if Copy(s,Length(s)-1,2) = ':' then
begin
ShowMessage('This cannot be used on the Root directory');
Exit;
end;
SendToRecycleBin(lbDirectories.Directory);
end;
end;
end;
procedure TForm1.SendToRecycleBin(sFileName :String);
begin
ZeroMemory(@sei, sizeof(sei));
with sei do
begin
cbSize := SizeOf(sei);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI;
Wnd := Form1.Handle;
lpVerb := 'delete';
lpFile := PChar(sFileName);
nShow := SW_SHOWNORMAL;
end;
ShellExecuteEX(@sei);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{
Need a flag to tell if focus is on DirectoryListBox, FileListBox,
or DriveComboBox because when the button is clicked,
Form1.ActiveControl won't point to any of them. This flag is used
in the case statements to operate differently on the differnet controls.
}
b := 0;
end;
procedure TForm1.lbDirectoriesEnter(Sender: TObject);
begin
b := 3;
end;
procedure TForm1.drvcbDrivesEnter(Sender: TObject);
begin
b := 1;
end;
procedure TForm1.lbFilesEnter(Sender: TObject);
begin
b := 2;
end;
procedure TForm1.BrowseTo(sURL, sBrowser, sDir :String);
begin
ZeroMemory(@sei, sizeof(sei));
with sei do
begin
cbSize := SizeOf(sei);
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Form1.Handle;
lpVerb := 'open';
// Need to see if sBrowser empty, if so, pass url to lpFile parameter
if sBrowser <> #0 then
lpFile := PChar(sBrowser)
else
lpFile := PChar(sURL);
lpParameters := PChar(sURL);
lpDirectory := PChar(sDir);
nShow := SW_SHOWNORMAL;
end;
ShellExecuteEX(@sei);
end;
procedure TForm1.btnBrowseToClick(Sender: TObject);
begin
BrowseTo('http://www.informant.com/undu/index.htm', 'netscape.exe',
'"C:Program FilesNetscapeNavigatorProgram"');
end;
end. |
|
