function ReadMWord(f: TFileStream): Word;
type
  TMotorolaWord = record
    case Byte of
      0: (Value: Word);
      1: (Byte1, Byte2: Byte);
    end;
var
  MW: TMotorolaWord;
begin
  f.Read(MW.Byte2, SizeOf(Byte));
  f.Read(MW.Byte1, SizeOf(Byte));
  Result := MW.Value;
end;

procedure GetJPGSize(const sFile: string; var wWidth, wHeight: Word);
const
  ValidSig: array[0..1] of Byte = ($FF, $D8);
  Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
var
  Sig: array[0..1] of Byte;
  f: TFileStream;
  x: Integer;
  Seg: byte;
  Dummy: array[0..15] of Byte;
  Len: Word;
  ReadLen: LongInt;
begin
  FillChar(Sig, SizeOf(Sig), #0);
  f := TFileStream.Create(sFile, fmOpenRead);
  try
    ReadLen := f.Read(Sig[0], SizeOf(Sig));

    for x := Low(Sig) to High(Sig) do
      if Sig[x] <> ValidSig[x] then
        ReadLen := 0;

    if ReadLen > 0 then
    begin
      ReadLen := f.Read(Seg, 1);
      while (Seg = $FF) and (ReadLen > 0) do
      begin
        ReadLen := f.Read(Seg, 1);
        if Seg <> $FF then
        begin
          if (Seg = $C0) or (Seg = $C1) then
          begin
            ReadLen := f.Read(Dummy[0], 3);
            wHeight := ReadMWord(f);
            wWidth := ReadMWord(f);
          end
          else
          begin
            if not (Seg in Parameterless) then
            begin
              Len := ReadMWord(f);
              f.Seek(Len-2, 1);
              f.Read(Seg, 1);
            end
            else
              Seg := $FF;
          end;
        end;
      end;
    end;
  finally
    f.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  w, h: Word;
begin
  GetJPGSize('c:\photo.jpg', w, h);
  ShowMessage(Format('Width: %d, Height: %d', [w, h]));
end;

// Программа должна поддерживать Unicode

function AddAccentToFilename(Path: WideString; Position: Word): Boolean;
var
  w, w1, w2: WideString;
begin
  w := Copy(Path, LastDelimiter('\', Path)+1, Length(Path));
  w1 := Copy(w, 1, Position);
  w2 := Copy(w, Position+1, Length(w));
  w := w1 + WideChar(769) + w2;
  Result := MoveFileW(Pointer(Path), Pointer(Copy(Path, 1, LastDelimiter('\', Path)) + w));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not AddAccentToFilename(Application.ExeName, 1) then
    ShowMessage(SysErrorMessage(GetLastError));
end;

uses
  ShellAPI;

function Recycle(const FileName: string; Wnd: HWND): Boolean;
var
  FileOp: TSHFileOpStruct;
begin
  if Wnd = 0 then
    Wnd := Application.Handle;
  FileOp.Wnd := Wnd;
  FileOp.wFunc := FO_DELETE;
  FileOp.pFrom := PChar(FileName);
  FileOp.pTo := nil;
  FileOp.fFlags := FOF_ALLOWUNDO or FOF_NOERRORUI or FOF_SILENT or FOF_NOCONFIRMATION;
  FileOp.fAnyOperationsAborted := False;
  FileOp.hNameMappings := nil;
  FileOp.lpszProgressTitle := nil;
  Result := (SHFileOperation(FileOp) = NO_ERROR) and (not FileOp.fAnyOperationsAborted);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Recycle('d:\folder\1.txt'#0, Handle);
end;

uses
  AclAPI;

type
  PACL_SIZE_INFORMATION = ^_ACL_SIZE_INFORMATION;
  _ACL_SIZE_INFORMATION = record
    AceCount : DWORD;
    AclBytesInUse : DWORD;
    AclBytesFree : DWORD;
  end;
  ACL_SIZE_INFORMATION = _ACL_SIZE_INFORMATION;

  PACE_HEADER = ^_ACE_HEADER;
  _ACE_HEADER = record
    AceType : BYTE;
    AceFlags : BYTE;
    AceSize : WORD;
  end;
  ACE_HEADER = _ACE_HEADER;

  PACCESS_ALLOWED_ACE = ^_ACCESS_ALLOWED_ACE;
  _ACCESS_ALLOWED_ACE = record
    Header : ACE_HEADER;
    Mask : ACCESS_MASK;
    SidStart : DWORD;
  end;
  ACCESS_ALLOWED_ACE = _ACCESS_ALLOWED_ACE;

const  // ACE inherit flags
  OBJECT_INHERIT_ACE         = $1;
  CONTAINER_INHERIT_ACE      = $2;
  NO_PROPAGATE_INHERIT_ACE   = $4;
  INHERIT_ONLY_ACE           = $8;
  INHERITED_ACE              = $10;
  VALID_INHERIT_FLAGS        = $1F;
  SUCCESSFUL_ACCESS_ACE_FLAG = $40;
  FAILED_ACCESS_ACE_FLAG     = $80;

const
  FILE_READ_DATA        = $0001;
  FILE_WRITE_DATA       = $0002;
  FILE_APPEND_DATA      = $0004;
  FILE_READ_EA          = $0008;
  FILE_WRITE_EA         = $0010;
  FILE_EXECUTE          = $0020;
  FILE_READ_ATTRIBUTES  = $0080;
  FILE_WRITE_ATTRIBUTES = $0100;

  FILE_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $1FF;
  FILE_GENERIC_READ = (STANDARD_RIGHTS_READ or FILE_READ_DATA or
    FILE_READ_ATTRIBUTES or FILE_READ_EA or SYNCHRONIZE);
  FILE_GENERIC_WRITE = (STANDARD_RIGHTS_WRITE or FILE_WRITE_DATA or
    FILE_WRITE_ATTRIBUTES or FILE_WRITE_EA or FILE_APPEND_DATA or SYNCHRONIZE);
  FILE_GENERIC_EXECUTE = (STANDARD_RIGHTS_EXECUTE or FILE_READ_ATTRIBUTES or
    FILE_EXECUTE or SYNCHRONIZE);

procedure AclCheck(const Value: BOOL; Ignore: DWORD = 0);
begin
  if not Value then
    if GetLastError <> Ignore then
      RaiseLastOSError;
end;

function GetInfo(AName: string): string;
var
  i, iLen, iLenDomain: DWORD;
  pSecurityDescriptor, pUserName, pDomain: string;
  lpbDaclPresent, lpbDaclDefaulted: BOOL;
  pDacl: PACL;
  pAce: Pointer;
  pAclInformation: ACL_SIZE_INFORMATION;
  peUse: SID_NAME_USE;
begin
  AclCheck(GetFileSecurity(PChar(AName), DACL_SECURITY_INFORMATION,
           nil, 0, iLen), ERROR_INSUFFICIENT_BUFFER);
  SetLength(pSecurityDescriptor, iLen);
  AclCheck(GetFileSecurity(PWideChar(AName), DACL_SECURITY_INFORMATION,
           Pointer(pSecurityDescriptor), iLen, iLen));
  AclCheck(GetSecurityDescriptorDACL(Pointer(pSecurityDescriptor),
           lpbDaclPresent, pDacl, lpbDaclDefaulted));
  AclCheck(GetAclInformation(pDacl^, Pointer(@pAclInformation),
           SizeOf(ACL_SIZE_INFORMATION), AclSizeInformation));

  Result := '';
  for i := 0 to pAclInformation.AceCount-1 do
  begin
    AclCheck( GetAce( pDacl^, i, pAce ) );
    with ACCESS_ALLOWED_ACE( pAce^ ) do
    begin
      iLen := 0;
      iLenDomain := 0;
      AclCheck(LookupAccountSid(nil, @SidStart, nil, iLen, nil,
               iLenDomain, peUse), ERROR_INSUFFICIENT_BUFFER);
      SetLength(pUserName, iLen);
      SetLength(pDomain, iLenDomain);
      AclCheck(LookupAccountSid(nil, @SidStart, Pointer(pUserName), iLen,
               Pointer( pDomain),  iLenDomain, peUse));
      SetLength(pUserName, iLen);
      SetLength(pDomain, iLenDomain);
      Result := Result + pDomain;
      if Length(pDomain) > 0 then
        Result := Result + '\';
      Result := Result + pUserName + ':';

      if (Header.AceFlags and OBJECT_INHERIT_ACE) > 0 then
        Result := Result + '(OI)';
      if (Header.AceFlags and CONTAINER_INHERIT_ACE) > 0 then
        Result := Result + '(CI)';
      if (Header.AceFlags and INHERIT_ONLY_ACE) > 0 then
        Result := Result + '(IO)';

      if (Mask and FILE_ALL_ACCESS) = FILE_ALL_ACCESS then
        Result := Result + 'F';
      if (Mask and FILE_GENERIC_READ) = FILE_GENERIC_READ then
        Result := Result + 'R';
      if (Mask and FILE_GENERIC_WRITE) = FILE_GENERIC_WRITE then
        Result := Result + 'W';
      if (Mask and FILE_GENERIC_EXECUTE) = FILE_GENERIC_EXECUTE then
        Result := Result + 'E';

      Result := Result + #13;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetInfo('c:\'));
end;

function ReadMWord(f: TFileStream): Word;
type
  TMotorolaWord = record
    case Byte of
      0: (Value: Word);
      1: (Byte1, Byte2: Byte);
    end;
var
  MW: TMotorolaWord;
begin
  f.Read(MW.Byte2, SizeOf(Byte));
  f.Read(MW.Byte1, SizeOf(Byte));
  Result := MW.Value;
end;

procedure GetPNGSize(const sFile: string; var wWidth, wHeight: Word);
type
  TPNGSig = array[0..7] of Byte;
const
  ValidSig: TPNGSig = (137, 80, 78, 71, 13, 10, 26, 10);
var
  Sig: TPNGSig;
  f: TFileStream;
  x: Integer;
begin
  FillChar(Sig, SizeOf(Sig), #0);
  f := TFileStream.Create(sFile, fmOpenRead);

  try
    f.Read(Sig[0], SizeOf(Sig));
    for x := Low(Sig) to High(Sig) do
      if Sig[x] <> ValidSig[x] then
        Exit;

    f.Seek(18, 0);
    wWidth := ReadMWord(f);
    f.Seek(22, 0);
    wHeight := ReadMWord(f);
  finally
    f.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  w, h: Word;
begin
  GetPNGSize('c:\photo.png', w, h);
  ShowMessage(Format('Width: %d, Height: %d', [w, h]));
end;

procedure GetGIFSize(const sFile: string; var wWidth, wHeight: Word);
type
  TGifHeader = record
    Signature: array [0..5] of AnsiChar;
    Width, Height: Word;
  end;
var
  Header: TGifHeader;
  fs: TFileStream;
begin
  FillChar(Header, SizeOf(TGifHeader), #0);
  wWidth := 0;
  wHeight := 0;

  try
    fs := TFileStream.Create(sFile, fmOpenRead or fmShareDenyWrite);
    with fs do
    begin
      Seek(0, soFromBeginning);
      ReadBuffer(Header, SizeOf(TGifHeader));
    end;

    if (AnsiUpperCase(Header.Signature) = 'GIF89A') or
       (AnsiUpperCase(Header.Signature) = 'GIF87A') then
    begin
      wWidth  := Header.Width;
      wHeight := Header.Height;
    end;
  finally
    fs.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  w, h: Word;
begin
  GetGIFSize('c:\photo.gif', w, h);
  ShowMessage(Format('Width: %d, Height: %d', [w, h]));
end;

// Способ первый
uses
  ShellAPI;

function RenameDir(DirFrom, DirTo: string): Boolean;
var
  ShellInfo: TSHFileOpStruct;
begin
  with ShellInfo do
  begin
    Wnd := Application.Handle;
    wFunc := FO_RENAME;
    pFrom := PChar(DirFrom);
    pTo := PChar(DirTo);
    fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or
              FOF_SILENT or FOF_NOCONFIRMATION;
  end;
  Result := SHFileOperation(ShellInfo) = 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Переименование файла
  RenameDir('c:\test\test.txt', 'c:\test\test1.txt');
  // Переименование каталога
  RenameDir('c:\test\', 'c:\test1\');
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
  // Переименование файла
  MoveFile('c:\test\test.txt', 'c:\test\test1.txt');
  // Переименование каталога
  MoveFile('c:\test1', 'c:\test');
end;

function FileIsUse(fName: string): Boolean;
var
  HFileRes: HFILE;
begin
  Result := False;

  if not FileExists(fName) then
    Exit;

  HFileRes := CreateFile(PChar(fName), GENERIC_READ, 0, nil, OPEN_EXISTING,
                         FILE_ATTRIBUTE_NORMAL, 0);
  Result := HFileRes = INVALID_HANDLE_VALUE;
  if not Result then
    CloseHandle(HFileRes);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if FileIsUse('c:\text.txt') then
    ShowMessage('Файл используется эксклюзивно')
  else
    ShowMessage('Файл не используется эксклюзивно');
end;

// Способ основан на-использованием функции WinAPI CreateFileMapping с флагом SEC_IMAGE.
// Такая комбинация сообщает системе, что проецируемый файл должен являться исполняемым,
// и, соответственно, память проекции надо подготовить соответствующим образом, с учетом
// заголовка и секций. Если файл не является корректным, например, повреждена структура
// секций или не соответствует заголовок, то CreateFileMapping вернет ошибку.

function CheckPEFile(FileName: string): Boolean;
var
  hFile, hFileMapping: NativeUInt;
  flProtect: Cardinal;
  pMemory: Pointer;
begin
  Result := False;
  hFile := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil,
                      OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  if hFile = INVALID_HANDLE_VALUE then
    Exit;

  // вся ФИШКА в SEC_IMAGE !!!
  flProtect := PAGE_READONLY or SEC_IMAGE;

  try
    hFileMapping := CreateFileMapping(hFile, nil, flProtect, 0, 0, nil);
    CloseHandle(hFile);
  except
    CloseHandle(hFile);
    Exit;
  end;

  if hFileMapping = 0 then
    Exit;

  try
    pMemory := MapViewOfFile(hFileMapping, FILE_MAP_READ, 0, 0, 0);
    Result := pMemory <> nil;
    if Result then
      UnmapViewOfFile(pMemory);
  finally
    CloseHandle(hFileMapping);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  case CheckPEFile('d:\РАН\Creator\Win32\Release\Settings.xml') of
    True: ShowMessage('Файл соответствует PE-формату.');
    False: ShowMessage('Файл не соответствует PE-формату.');
  end;
end;

uses
  ShlObj, ActiveX, ComObj;

procedure ShowSysPopup(aFile: string; x, y: integer; HND: HWND);
var
  Root: IShellFolder;
  ShellParentFolder: IShellFolder;
  chEaten,dwAttributes: ULONG;
  FilePIDL,ParentFolderPIDL: PItemIDList;
  CM: IContextMenu;
  Menu: HMenu;
  Command: LongBool;
  ICM2: IContextMenu2;
  ICI: TCMInvokeCommandInfo;
  ICmd: Integer;
  P: TPoint;
begin
  // Get the Desktop IShellFolder interface
  OleCheck(SHGetDesktopFolder(Root));

  // Get the PItemIDList of the parent folder
  OleCheck(Root.ParseDisplayName(HND, nil,
    PWideChar(WideString(ExtractFilePath(aFile))),
    chEaten, ParentFolderPIDL, dwAttributes));

  // Get the IShellFolder Interface  of the Parent Folder
  OleCheck(Root.BindToObject(ParentFolderPIDL, nil, IShellFolder,
    ShellParentFolder));

  // Get the relative  PItemIDList of the File
  OleCheck(ShellParentFolder.ParseDisplayName(HND, nil,
    PWideChar(WideString( ExtractFileName(aFile))),
    chEaten, FilePIDL, dwAttributes));

  // Get the IContextMenu Interace for the file
  ShellParentFolder.GetUIObjectOf(HND, 1, FilePIDL, IID_IContextMenu, nil, CM);

  if CM = nil then
    Exit;

  P.X := X;
  P.Y := Y;

  Winapi.Windows.ClientToScreen(HND, P);

  Menu := CreatePopupMenu;

  try
    CM.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME);
    CM.QueryInterface(IID_IContextMenu2, ICM2); // To handle submenus.
    try
      Command := TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or
        TPM_RIGHTBUTTON or TPM_RETURNCMD, p.X, p.Y, 0, HND, nil);
    finally
      ICM2 := nil;
    end;

    if Command then
    begin
      ICmd := LongInt(Command) - 1;
      FillChar(ICI, SizeOf(ICI), #0);
      with ICI do
      begin
        cbSize := SizeOf(ICI);
        hWND := 0;
        lpVerb := MakeIntResourceA(ICmd);
        nShow := SW_SHOWNORMAL;
      end;
      CM.InvokeCommand(ICI);
    end;
  finally
    DestroyMenu(Menu);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowSysPopup('c:\Windows\System32\calc.exe', Button1.Left, Button1.Top, Handle);
end;

//initialization
//  OleInitialize(nil);

//finalization
//  OleUninitialize;