unit FmxUtils;

interface

uses SysUtils, Windows, Classes, Consts, Dialogs;

type
  EInvalidDest = class(EStreamError);
  EFCantMove = class(EStreamError);

procedure CopyFile(const FileName, DestName: string);
procedure MoveFile(const FileName, DestName: string);
function GetFileSize(const FileName: string): LongInt;
function FileDateTime(const FileName: string): TDateTime;
function HasAttr(const FileName: string; Attr: Word): Boolean;
function ExecuteFile(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer): THandle;
procedure ExecuteFileEx(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer);
function GetShortName(sLongName: string): string;
function IsWow64(var s:string): Boolean;

implementation

uses Forms, ShellAPI, RtlConsts;

const
  SInvalidDest = 'Destination %s does not exist';
  SFCantMove = 'Cannot move file %s';

procedure CopyFile(const FileName, DestName: string);
var
  CopyBuffer: Pointer; { buffer for copying }
  BytesCopied: Longint;
  Source, Dest: Integer; { handles }
  Len: Integer;
  Destination: TFileName; { holder for expanded destination name }
const
  ChunkSize: Longint = 8192; { copy in 8K chunks }
begin
  Destination := ExpandFileName(DestName); { expand the destination path }
  if HasAttr(Destination, faDirectory) then { if destination is a directory... }
  begin
    Len :=  Length(Destination);
    if Destination[Len] = '\' then
      Destination := Destination + ExtractFileName(FileName) { ...clone file name }
    else
      Destination := Destination + '\' + ExtractFileName(FileName); { ...clone file name }
  end;
GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
  try
    Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
    if Source < 0 then raise EFOpenError.CreateFmt(SFOpenError, [FileName]);
    try
      Dest := FileCreate(Destination); { create output file; overwrite existing }
      if Dest < 0 then raise EFCreateError.CreateFmt(SFCreateError, [Destination]);
      try
        repeat
          BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
          if BytesCopied > 0 then { if we read anything... }
            FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
        until BytesCopied < ChunkSize; { until we run out of chunks }
      finally
        FileClose(Dest); { close the destination file }
      end;
    finally
      FileClose(Source); { close the source file }
    end;
  finally
    FreeMem(CopyBuffer, ChunkSize); { free the buffer }
  end;
end;


{ MoveFile procedure }
{
  Moves the file passed in FileName to the directory specified in DestDir.
  Tries to just rename the file.  If that fails, try to copy the file and
  delete the original.

  Raises an exception if the source file is read-only, and therefore cannot
  be deleted/moved.
}

procedure MoveFile(const FileName, DestName: string);
var
  Destination: string;
begin
  Destination := ExpandFileName(DestName); { expand the destination path }
  if not RenameFile(FileName, Destination) then { try just renaming }
  begin
    if HasAttr(FileName, faReadOnly) then  { if it's read-only... }
      raise EFCantMove.Create(Format(SFCantMove, [FileName])); { we wouldn't be able to delete it }
      CopyFile(FileName, Destination); { copy it over to destination...}
//      DeleteFile(FileName); { ...and delete the original }
  end;
end;

{ GetFileSize function }
{
  Returns the size of the named file without opening the file.  If the file
  doesn't exist, returns -1.
}

function GetFileSize(const FileName: string): LongInt;
var
  SearchRec: TSearchRec;
begin
  try
    if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
      Result := SearchRec.Size
    else Result := -1;
  finally
    SysUtils.FindClose(SearchRec);
  end;
end;

function FileDateTime(const FileName: string): System.TDateTime;
begin
  Result := FileDateToDateTime(FileAge(FileName));
end;

function HasAttr(const FileName: string; Attr: Word): Boolean;
var
 FileAttr: Integer;
begin
  FileAttr := FileGetAttr(FileName);
  if FileAttr = -1 then FileAttr := 0;
  Result := (FileAttr and Attr) = Attr;
end;

function ExecuteFile(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer): THandle;
var
  zFileName, zParams, zDir: array[0..2047] of Char;  // ALE 20090725 lengthened from 79
begin
  Result := ShellExecute(Application.MainForm.Handle, nil,
    StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
    StrPCopy(zDir, DefaultDir), ShowCmd);
end;

procedure ExecuteFileEx(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer);
var
  zFileName, zParams, zDir: array[0..2047] of Char;  // ALE 20090725 lengthened from 79
  SEInfo: TShellExecuteInfo;
  ExitCode: DWORD;
begin

  FillChar(SEInfo, SizeOf(SEInfo), 0);
  SEInfo.cbSize := SizeOf(TShellExecuteInfo);
  with SEInfo do begin
    fMask := SEE_MASK_NOCLOSEPROCESS;
    Wnd := Application.Handle;
    lpFile := PChar(FileName);
    {
      ParamString can contain the
      application parameters.
    }
    lpParameters := PChar(Params);
    {
      StartInString specifies the
      name of the working directory.
      If ommited, the current directory is used.
    }
    lpDirectory := PChar(DefaultDir);
    nShow := ShowCmd;
  end;
  if ShellExecuteEx(@SEInfo) then begin
    repeat
      Application.ProcessMessages;
      GetExitCodeProcess(SEInfo.hProcess, ExitCode);
    until (ExitCode <> STILL_ACTIVE) or
	   Application.Terminated;
    //ShowMessage('Calculator terminated');
  end
  else
    ShowMessage('Error starting ' + FileName);
end;

// ALE 20090802 needed a way to get shortname
function GetShortName(sLongName: string): string;
var
  sShortName:    string;
  nShortNameLen: Integer;
begin
  SetLength(sShortName, MAX_PATH);
  nShortNameLen := GetShortPathName(PChar(sLongName), PChar(sShortName), MAX_PATH - 1);
  if (0 = nShortNameLen) then
  begin
    // handle errors...
    // ALE 20090802 works ShowMessage(SysErrorMessage(GetLastError));
  end;
  SetLength(sShortName, nShortNameLen);
  Result := sShortName;
end;

// ALE 20090802 figure out if we'll have a 16-bit subsystem by looking for 32-bit
function IsWow64(var s:string): Boolean;
{Returns true if the current process is executing as a 32 bit process under
WOW64 on 64 bit Windows. s gives status message}
type
  TIsWow64Process = function(// Type of IsWow64Process API fn
  Handle: Windows.THandle; var Res: Windows.BOOL): Windows.BOOL; stdcall;
var
  IsWow64Result: Windows.BOOL; // Result from IsWow64Process
  IsWow64Process: TIsWow64Process; // IsWow64Process fn reference
begin
  Result := False;
  // Try to load required function from kernel32
  IsWow64Process := Windows.GetProcAddress(
  Windows.GetModuleHandle('kernel32'), 'IsWow64Process');
  if Assigned(IsWow64Process) then
  begin
    if IsWow64Process(Windows.GetCurrentProcess, IsWow64Result) then
    begin
      Result := IsWow64Result;
      if Result then
        s := 'Process is running on Wow64'
      else
        s := 'Process is NOT running on Wow64';
    end
    else
      s := 'IsWow64 call failed';
  end
  else
    s := 'IsWow64Process not present in kernel32.dll';
end;

end.