Disks and Files

How to get files "Last Accessed" attribute?

From: Jon Erik Oterhals <jonoter@stud.ntnu.no>

Brian Fløe Sørensen wrote:

 In Windows 95, you can see when a file was last accessed by right-clicking
 the file and selecting properties.

 How can I get this information in Delphi/API???


procedure TForm1.Button1Click(Sender: TObject);
var
  FileHandle : THandle;
  LocalFileTime : TFileTime;
  DosFileTime : DWORD;
  LastAccessedTime : TDateTime;
  FindData : TWin32FindData;
begin
  FileHandle := FindFirstFile('AnyFile.FIL', FindData);
  if FileHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      FileTimeToDosDateTime(LocalFileTime,
      LongRec(DosFileTime).Hi,LongRec(DosFileTime).Lo);
      LastAccessedTime := FileDateToDateTime(DosFileTime);
      Label1.Caption := DateTimeToStr(LastAccessedTime);
    end;
  end;
end;

How do I convert "Long File Name.pas" to "longfi~1.pas"?

From: "DynaSoft." <TimH@onaustralia.com.au>

Here try these procedures.


Function GetShortFileName(Const FileName : String) : String;
var
  aTmp: array[0..255] of char;
begin
  if GetShortPathName(PChar(FileName),aTmp,Sizeof(aTmp)-1)=0 then
     Result:= FileName
  else
     Result:=StrPas(aTmp);
end;

Function GetLongFileName(Const FileName : String) : String;
var
  aInfo: TSHFileInfo;
begin
  if SHGetFileInfo(PChar(FileName),0,aInfo,Sizeof(aInfo),SHGFI_DISPLAYNAME)<>0 then
     Result:= String(aInfo.szDisplayName)
  else
     Result:= FileName;
end;

HDD Serial Number

From: Christian Piene Gundersen <j.c.p.gundersen@jusstud.uio.no>

> We need to know how can we get the serial number of a HDD, working with
> Delphi 2.0

Try this:


procedure TForm1.Button1Click(Sender: TObject);
var
  SerialNum : pdword;
  a, b : dword;
  Buffer  : array [0..255] of char;
begin
  if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then
    Label1.Caption := IntToStr(SerialNum^);
end;

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;

Audio CD

From: "Chris Rankin" <RankinC@Logica.com>

Vincent Oostindie <vincent.oostindie@tip.nl> wrote
> * How do I get the unique number from an audio CD in the CD-ROM drive?

const
  MCI_INFO_PRODUCT                = $00000100;
  MCI_INFO_FILE                   = $00000200;
  MCI_INFO_MEDIA_UPC              = $00000400;
  MCI_INFO_MEDIA_IDENTITY         = $00000800;
  MCI_INFO_NAME                   = $00001000;
  MCI_INFO_COPYRIGHT              = $00002000;

{ parameter block for MCI_INFO command message }
type
  PMCI_Info_ParmsA = ^TMCI_Info_ParmsA;
  PMCI_Info_ParmsW = ^TMCI_Info_ParmsW;
  PMCI_Info_Parms = PMCI_Info_ParmsA;
  TMCI_Info_ParmsA = record
    dwCallback: DWORD;
    lpstrReturn: PAnsiChar;
    dwRetSize: DWORD;
  end;
  TMCI_Info_ParmsW = record
    dwCallback: DWORD;
    lpstrReturn: PWideChar;
    dwRetSize: DWORD;
  end;
  TMCI_Info_Parms = TMCI_Info_ParmsA;

These are the buffers you want: the identifier is returned as a string of decimal digits by the MCI_INFO_MEDIA_IDENTITY function. You should be able to cross-reference this with the online help (Win32 and TMediaPlayer component).

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;

getting datetime problem

From: laserjet <laserjet@concentric.net>

Try the following function which does not require FindFirst:


 function GetFileDate(TheFileName: string): string;
 var
   FHandle: integer;
 begin
   FHandle := FileOpen(TheFileName, 0);
   result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
   FileClose(FHandle);
 end;

From: bziegler@Radix.Net (Ben Ziegler)

One note of caution, some of the Win32 functions return times in GMT time, and you have to convert it to local time. Check your docs to be sure. (FindNextFile does this I believe).

Coping of the files

I have diffculties with coping the files. Delphi don't want to compile LZCopy command.

this way it work very slow


pbBuf := PChar( LocalAlloc(LMEM_FIXED, 1) );

FileSeek(source,0,0);
FileSeek(dest,0,0);
repeat
    cbRead := Fileread(source, pbBuf, 1);
    FileWrite(dest, pbBuf, cbRead);
until (cbRead = 0);

Solution 1

[Niel Calitz, omremcon@iafrica.com]
{  You must add LZExpand to your uses clause  ea. USES LZExpand; }
function CopyFile(SrcF,DestF : string) : boolean;
var
  SFile,
  DFile : integer;
  Res   : longint;
  Msg   : string;

begin
  SFile := FileOpen(SrcF,0);        { Open ReadOnly = 0, Write=1, Readwrite=2}
  DFile := FileCreate(DestF);
  Res := LZCopy(SFile,DFile);
  FileClose(SFile);
  FileClose(DFile);
  if Res < 0 then
  begin
    Msg := 'Unknown error';
    case Res of
      LZERROR_BADINHANDLE   : Msg := 'Invalid Source file handle';
      LZERROR_BADOUTHANDLE  : Msg := 'Invalid Destination file handle';
      LZERROR_BADVALUE      : Msg := 'Input parameter is out of range';
      LZERROR_GLOBALLOC     : Msg := 'Insufficient memory for the required buffers';
      LZERROR_GLOBLOCK      : Msg := 'Internal data structure handle invalid';
      LZERROR_READ          : Msg := 'Source file format is not valid';
      LZERROR_UNKNOWNALG    : Msg := 'The Source file was compressed with an unrecognized compression algorithm';
      LZERROR_WRITE         : Msg := 'There is insufficient space for the output file';
    end;
    MessageDlg(Msg,mtERROR,[mbOK],0);
    result := FALSE
  end else
    result := TRUE;
end;

Solution 2

[Tadas Vizbaras, tavizb@rc.lrs.lt]

I'll bet it's slow! It's reading the file one character at a time... Try allocating 8192 bytes and reading 8192 bytes at a time. That should speed it up a bit...

Solution 3

[Sid Gudes, cougar@roadrunner.com]

The simplest way to copy files is this:


                VAR
                         sI,dI:Longint;
                        sD,sS:TFilename;

                USES LZExpand;
                        ............
                  sI := FileOpen(sS,fmShareDenyWrite);
                 dI := FileCreate(sD);
                  { Copy file }
                   CopyLZFile(sI,dI);
                  {close files}
                 FileClose(sI);
                 FileClose(dI);
                        ............

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[NEW]

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.

Search Harddisk[NEW]

From: "Eric Lawrence" <deltagrp@wam.umd.edu>

>> I'm looking for a method or a component that search the entire harddisk
>>after certain files, for example (*.exe)...

unit Audit1;
interface
uses windos;

var
  dest:string;

procedure dorecurse(dir:string);

implementation
{$R *.DFM}
Procedure Process (dir:string; Searchrec:tsearchrec);
begin
   showmessage (Searchrec.name);
   case Searchrec.attr of
   $10:
      if (searchrec.name<>'.') and (searchrec.name<>'..') then
	  begin
        dorecurse (dir+'\'+searchrec.name);
		writeln (dir);
	  end;
   end;
end;

Procedure Dorecurse(dir:string);
var
   Searchrec:Tsearchrec;
   pc: array[0..79] of Char;
   
begin
   StrPCopy(pc, dir+'\*.*');
   FindFirst(pc, FaAnyfile, SearchRec);
   Process (dir,SearchRec);
   while FindNext(SearchRec)<>-18 do
   begin
      Process (dir,SearchRec);
   end;
end;

Procedure startsearch;
begin
   dorecurse (paramstr(1));
end;

begin
   startsearch;
end.

The date of a folder[NEW]

From: "Bjorn Heidarr" <bhg@centrum.is>

This function below which does this:


function FolderDate(sFolder : String) : TDate;
var SearchRec : TSearchRec;
    Found : integer;
    dt : TDate;
begin
    Result := 0;
    Found := FindFirst(sFolder, faDirectory, SearchRec);
    if Found = 0 then
    begin
        dt := FileDateToDateTime(SearchRec.Time);
        result := dt;
    end;
    FindClose(SearchRec);
end;


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

This page has been created with HomeSite 2.5b