Disks
  1. How to check if drive 'a:' is ready?
  2. How can I delete a file to the Recycle Bin?
  3. Shortened Directory label
  4. Format Function / Procedure
  5. How to create shortcuts?
  6. How do I find out total size in a directory?[NEW]

How to check if drive 'a:' is ready?

From: "Angus Johnson" <ajohnson@rpi.net.au>


function DiskInDrive(const Drive: char): Boolean;
var
  DrvNum: byte;
  EMode: Word;
begin
  result := false;
  DrvNum := ord(Drive);
  if DrvNum >= ord('a') then dec(DrvNum,$20);
  EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    if DiskSize(DrvNum-$40) <> -1 then result := true
    else messagebeep(0);
  finally
    SetErrorMode(EMode);
  end;
end;

How can I delete a file to the Recycle Bin?

From: "Ed Lagerburg" <lagerbrg@euronet.nl>
program del;

uses
 ShellApi;

//function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall;

Var T:TSHFileOpStruct;
    P:String;
begin
  P:='C:\Windows\System\EL_CONTROL.CPL';
  With T do
  Begin
    Wnd:=0;
    wFunc:=FO_DELETE;
    pFrom:=Pchar(P);
    fFlags:=FOF_ALLOWUNDO
  End;
  SHFileOperation(T);
End.

From: bstowers@pobox.com (Brad Stowers)

There are some other quirks you should be aware of, too:

An example of how to do this would be:

var
  FileList: string;
  FOS: TShFileOpStruct;
begin
  FileList := 'c:\delete.me'#0'c:\windows\temp.$$$'#0#0;
  { if you were using filenames in string variables: }
  FileList := Filename1 + #0 + Filename2 + #0#0;

  FOS.pFrom := PChar(FileList);

  // blah blah blah
end;

Shortened Directory label

If the directory label is:
c:\windows\media\temp\abc\sound\chime.wav
I would like the label to appear as:
c:\windows\..\sound\chime.wav
and not the whole chunk of filename.
Is there any way to accomplish this easily? [Stephan Meyer, sm006ns@munich.netsurf.de]

I developed a procedure, that does something like that. It shortens the path, when it and the current path have the same drive and/or directory in parts. It's really useful for making the pathname easier to read and understand. I've written it for a hex-editor in Borland Pascal and I haven't been using it for a while, but it should work flawlessly.


function shortenfilename(s : string) : string;
var drive,curdrive : string[2];
    dir,curdir : string[80];
    name : string[20];
    ext : string[5];
    i : byte;
begin
  for i:=1 to length(s) do s[i]:=upcase(s[i]);
  s:=fexpand(s);
  fsplit(s,dir,name,ext);
  drive:=copy(dir,1,2);
  dir:=copy(dir,4,length(dir)-3);
  getdir(0,curdir);
  curdrive:=copy(curdir,1,2);
  curdir:=copy(curdir,4,length(curdir)-3)+'\';
  if drive=curdrive then begin
    if copy(dir,1,length(curdir))=curdir then begin
      i:=length(curdir);
      if length(dir)<>i then dir:=dir+'\';
      shortenfilename:=copy(dir,i+1,length(dir)-i-1)+name+ext;
    end else shortenfilename:=copy(s,3,length(s)-2);
  end else shortenfilename:=s;
end;

Format Function / Procedure

From: david.ku@virgin.net (David Ku)

There is an API hidden away in Shell32.dll called SHFormatDrive, this brings up the standard format removable drive dialog. I stumbled across this in the borland.public.delphi.winapi newsgroup.


{implementation section}
..
..
const
        SHFMT_ID_DEFAULT                         = $FFFF;
        // Formating options
        SHFMT_OPT_QUICKFORMAT   = $0000;
        SHFMT_OPT_FULL                          = $0001;
        SHFMT_OPT_SYSONLY               = $0002;
        // Error codes
        SHFMT_ERROR                                     = $FFFFFFFF; 
        SHFMT_CANCEL                            = $FFFFFFFE; 
        SHFMT_NOFORMAT                          = $FFFFFFFD; 

function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt;
        stdcall; external 'shell32.dll' name 'SHFormatDrive'

procedure TForm1.btnFormatDiskClick(Sender: TObject);
var
        retCode: LongInt;
begin
        retCode:=       SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT,
                                                                SHFMT_OPT_QUICKFORMAT);
        if retCode < 0 then
                ShowMessage('Could not format drive');
end;

end.

How to del ALL files within directory

From: TM

Try this:


procedure TfrmMain.DelDir(DirName: string);
var
        SearchRec: TSearchRec;
        GotOne: integer;
begin
        GotOne:= FindFirst(DirName + '\*.*', faAnyFile, SearchRec);
        while GotOne = 0 do
        begin
                if ((SearchRec.Attr and faDirectory) = 0) then
                        DeleteFile(DirName + '\' + SearchRec.Name)
                        else if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
                                DelDir(DirName + '\' + SearchRec.Name);
                GotOne:= FindNext(SearchRec);
        end;
        FindClose(SearchRec);
end;

If you want to delete the directory afterwards, you could do something like this:
//--------
        DelDir('C:\WASTE');
        {-I}
        RmDir('C:\WASTE');
        {+I}
        if IOResult <> 0 then
                raise Exception.Create('Error removing directory');
//-------

The recursion code, AFAIK, is by David Ullrich. *tips hat*

How to create shortcuts?

Reid Roman <rkroman@pacbell.net>

Borland Tech Doc #3234

This sample project demonstrates an easy way to add shortcuts to your Windows 95 or Windows NT 4.0 desktop or start menu.

  1. Launch Delphi 3.
  2. 2. In a new project, drop a TButton on the form (make sure it's called Button1). Then double click on Button1. Now you can go ahead and directly replace the code for Unit1 with the code for Unit1 below.
The program will set up a shortcut either (see the code) on the desktop or on the start menu. The shortcut will be called FooBar and it will open up your AUTOEXEC.BAT in NOTEPAD when executed.

It will read the value of the "Desktop" and "Start Menu" strings from the registry key named (under HKEY_CURRENT_USER):

 Software\MicroSoft\Windows\CurrentVersion\Explorer\Shell Folders

--------------
The Unit1 unit
--------------

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  ShlObj, ActiveX, ComObj, Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyObject  : IUnknown;
  MySLink   : IShellLink;
  MyPFile   : IPersistFile;
  FileName  : String;
  Directory : String;
  WFileName : WideString;
  MyReg     : TRegIniFile;
begin
  MyObject := CreateComObject(CLSID_ShellLink);
  MySLink := MyObject as IShellLink;
  MyPFile := MyObject as IPersistFile;
  FileName := 'NOTEPAD.EXE';
  with MySLink do begin
    SetArguments('C:\AUTOEXEC.BAT');
    SetPath(PChar(FileName));
    SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
  end;
  MyReg := TRegIniFile.Create(
    'Software\MicroSoft\Windows\CurrentVersion\Explorer');

// Use the next line of code to put the shortcut on your desktop
  Directory := MyReg.ReadString('Shell Folders','Desktop','');

// Use the next three lines to put the shortcut on your start menu
//  Directory := MyReg.ReadString('Shell Folders','Start Menu','')+
//      '\Whoa!';
//  CreateDir(Directory);

  WFileName := Directory+'\FooBar.lnk';
  MyPFile.Save(PWChar(WFileName),False);
  MyReg.Free;
end;

end.

How do I find out total size in a directory?[NEW]

From: Roger Fylling <rfyfr97@student.hv.se>

Try the following (it looks at hidden,system,archive, and normal files; it uses a recursive algorithm to look in all sub-directories also; just supply a starting directory as a parameter and your answer will be in the variable DirBytes; please note that I've used FileExists and DirectoryExists instead of the attributes on the file to determine if it's a file or a directory. The reason is that the FindFirst and FindNext function sometimes says that a file is a directory when browsing CD-ROM's and such. This code works around that bug. The code was made by me(Roger Fylling)):


var
  DirBytes : integer;

function TFileBrowser.DirSize(Dir:string):integer;
var
  SearchRec : TSearchRec;
  Separator : string;
begin
  if Copy(Dir,Length(Dir),1)='\' then
    Separator := ''
  else
    Separator := '\';
  if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then begin
    if FileExists(Dir+Separator+SearchRec.Name) then begin
      DirBytes := DirBytes + SearchRec.Size;
      {Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
    end else if DirectoryExists(Dir+Separator+SearchRec.Name) then begin
      if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then begin
        DirSize(Dir+Separator+SearchRec.Name);
      end;
    end;
    while FindNext(SearchRec) = 0 do begin
      if FileExists(Dir+Separator+SearchRec.Name) then begin
        DirBytes := DirBytes + SearchRec.Size;
        {Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
      end else if DirectoryExists(Dir+Separator+SearchRec.Name) then
      begin
        if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then begin
          DirSize(Dir+Separator+SearchRec.Name);
        end;
      end;
    end;
  end;
  FindClose(SearchRec);
end;


Please email me and tell me if you liked this page.