1. How to get files "Last Accessed" attribute?
2. How do I convert "Long File Name.pas" to "longfi~1.pas"?
3. HDD Serial Number
4. How to check if drive 'a:' is ready?
5. Audio CD
6. How can I delete a file to the Recycle Bin?
7. getting datetime problem
8. Coping of the files
9. Shortened Directory label
10. Format Function / Procedure
11. Search Harddisk
12. How to create shortcuts?

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"?

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

> 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?

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

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?

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.

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

• Give the complete file path for every file specified. Do not rely on the current directory, even if you change to it right before the call. The SHFileOperation API is not "smart" enough to use the current directory if one is not given for undo information. So, even if you give the FOF_ALLOWUNDO flag, it will not move deleted files to the recycle bin because it doesn't know what path they came from, and thus couldn't restore them to their original location from the recycle bin. It will simply delete the file from the current directory.

• MS has a documentation correction about the pFrom member. It says that for multiple files, each filename is seperated by a NULL (#0) character, and the whole thing is terminated by double NULLs. You need the double NULL whether or not you are passing multiple filenames. Sometimes it will work correctly without them, but often not. That's because sometimes you get lucky and the memory following the end of your string has a NULL there.

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>

 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)

Coping of the files

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

{  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

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

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

c:\windows\media\temp\abc\sound\chime.wav

c:\windows\..\sound\chime.wav

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

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

>> 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.

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;

//--------
        DelDir('C:\WASTE');
        {-I}
        RmDir('C:\WASTE');
        {+I}
        if IOResult <> 0 then
                raise Exception.Create('Error removing directory');
//-------

How to create shortcuts?

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.

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.