FAQ VCL
Файлы и файловая система

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как найти программу, которая держит файл?

{$A+,Z4}

const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;

  RstrtMgr = 'Rstrtmgr.dll';

  // RM_SESSION_KEY_LEN - size in bytes of binary session key
  RM_SESSION_KEY_LEN = SizeOf(TGUID);
  // CCH_RM_SESSION_KEY - character count of text-encoded session key
  CCH_RM_SESSION_KEY = RM_SESSION_KEY_LEN * 2;
  // CCH_RM_MAX_APP_NAME - maximum character count of application friendly name
  CCH_RM_MAX_APP_NAME = 255;
  // CCH_RM_MAX_SVC_NAME - maximum character count of service short name
  CCH_RM_MAX_SVC_NAME = 63;
  // Uninitialized value for TS Session ID
  RM_INVALID_TS_SESSION = -1;
  // Uninitialized value for Process ID
  RM_INVALID_PROCESS = -1;

type
  TAppName = array[0..CCH_RM_MAX_APP_NAME] of WideChar;
  TServiceName = array[0..CCH_RM_MAX_SVC_NAME] of WideChar;
  TSessionKey = array[0..CCH_RM_SESSION_KEY] of WideChar;

  _RM_APP_TYPE = (
    // Application type cannot be classified in known categories
    RmUnknownApp = 0,
    // Application is a windows application that displays a top-level window
    RmMainWindow = 1,
    // Application is a windows app but does not display a top-level window
    RmOtherWindow = 2,
    // Application is an NT service
    RmService = 3,
    // Application is Explorer
    RmExplorer = 4,
    // Application is Console application
    RmConsole = 5,
    // Application is critical system process where a reboot is required to restart
    RmCritical = 1000
  );
  RM_APP_TYPE = _RM_APP_TYPE;
  TRMAppType = RM_APP_TYPE;

  _RM_SHUTDOWN_TYPE = (
    // Force app shutdown
    RmForceShutdown = $1,
    // Only shudown apps if all apps registered for restart
    RmShutdownOnlyRegistered = $10
  );
  RM_SHUTDOWN_TYPE = _RM_SHUTDOWN_TYPE;
  TRMShutdownType = RM_SHUTDOWN_TYPE;

  _RM_APP_STATUS = (
    // Application in unknown state or state not important
    RmStatusUnknown = $0,
    // Application is currently running
    RmStatusRunning = $1,
    // Application stopped by Restart Manager
    RmStatusStopped = $2,
    // Application detected stopped by outside action
    RmStatusStoppedOther = $4,
    // Application restarted by Restart Manager
    RmStatusRestarted = $8,
    // An error occurred when stopping this application
    RmStatusErrorOnStop = $10,
    // An error occurred when restarting this application
    RmStatusErrorOnRestart = $20,
    // Shutdown action masked by filer
    RmStatusShutdownMasked = $40,
    // Restart action masked by filter
    RmStatusRestartMasked = $80
  );
  RM_APP_STATUS = _RM_APP_STATUS;
  TRMAppStatus = RM_APP_STATUS;

  _RM_REBOOT_REASON = (
    // Reboot not required
    RmRebootReasonNone = $0,
    // Current user does not have permission to shut down one or more detected processes
    RmRebootReasonPermissionDenied = $1,
    // One or more processes are running in another TS session
    RmRebootReasonSessionMismatch = $2,
    // A critical process has been detected
    RmRebootReasonCriticalProcess = $4,
    // A critical service has been detected
    RmRebootReasonCriticalService = $8,
    // The current process has been detected
    RmRebootReasonDetectedSelf = $10
  );
  RM_REBOOT_REASON = _RM_REBOOT_REASON;
  TRMRebootReason = RM_REBOOT_REASON;

  _RM_UNIQUE_PROCESS = record
    // PID
    dwProcessId: DWORD;
    // Process creation time
    ProcessStartTime: TFileTime;
  end;
  RM_UNIQUE_PROCESS = _RM_UNIQUE_PROCESS;
  PRM_UNIQUE_PROCESS = ^_RM_UNIQUE_PROCESS;
  TRMUniqueProcess = RM_UNIQUE_PROCESS;
  PRMUniqueProcess = PRM_UNIQUE_PROCESS;

  _RM_PROCESS_INFO = record
    // Unique process identification
    Process: TRMUniqueProcess;
    // Application friendly name
    strAppName: TAppName;
    // Service short name, if applicable
    strServiceShortName: TServiceName;
    // Application type
    ApplicationType: TRMAppType;
    // Bit mask of application status
    AppStatus: ULONG;
    // Terminal Service session ID of process (-1 if n/a)
    TSSessionId: DWORD;
    // Is application restartable?
    bRestartable: BOOL;
  end;
  RM_PROCESS_INFO = _RM_PROCESS_INFO;
  PRM_PROCESS_INFO = ^_RM_PROCESS_INFO;
  TRMProcessInfo = RM_PROCESS_INFO;
  PRMProcessInfo = PRM_PROCESS_INFO;

  function QueryFullProcessImageName(hProcess: THandle; dwFlags: DWORD;
    lpExeName: PChar; var lpdwSize: Integer): BOOL; stdcall; external kernel32
    name {$IFDEF UNICODE}'QueryFullProcessImageNameW'{$ELSE}'QueryFullProcessImageNameA'{$ENDIF};

  function RmStartSession(out pSessionHandle: DWORD; dwSessionFlags: DWORD;
    out strSessionKey: TSessionKey): DWORD; stdcall; external RstrtMgr;
  function RmEndSession(dwSessionHandle: DWORD): DWORD; stdcall; external RstrtMgr;
  function RmRegisterResources(dwSessionHandle: DWORD; nFiles: UINT;
    rgsFileNames: PWideChar; nApplications: UINT; rgApplications: PRMUniqueProcess;
    nServices: UINT; rgsServiceNames: PPWideChar): DWORD; stdcall; external RstrtMgr;
  function RmGetList(dwSessionHandle: DWORD; out pnProcInfoNeeded: UINT; var pnProcInfo: UINT;
    out rgAffectedApps: TRMProcessInfo; out lpdwRebootReasons: DWORD): DWORD; stdcall; external RstrtMgr;

procedure TForm1.Button1Click(Sender: TObject);

  function StrFromAppType(const AAppType: TRMAppType): String;
  begin
    case AAppType of
      RmMainWindow:
        // WindowsZприложение в отдельном процессе с главным окном
        Result := 'Application is a windows application that displays a top-level window';
      RmOtherWindow:
        // WindowsZприложение без отдельного процесса и главного окна
        Result := 'Application is a windows app but does not display a top-level window';
      RmService:
        // Сервис Windows
        Result := 'Application is an NT service';
      RmExplorer:
        // Windows Explorer
        Result := 'Application is Explorer';
      RmConsole:
        // Консольное приложение
        Result := 'Application is Console application';
      RmCritical:
        // Процесс, критичный для Windows
        Result := 'Application is critical system process where a reboot is required to restart';
    else
      // Приложение не может быть классифицировано
      Result := 'Application type cannot be classified in known categories';
    end;
  end;

const
  Num = 10;

var
  dwSession: DWORD;
  szSessionKey: TSessionKey;
  pszFile: PWideChar;
  P: PWideChar;
  FileName: WideString;
  dwReason: DWORD;
  i: Integer;
  nProcInfoNeeded: UINT;
  nProcInfo: UINT;
  rgpi: array[0..Num-1] of TRMProcessInfo;
  hProcess: THandle;
  ftCreate, ftExit, ftKernel, ftUser: TFileTime;
  sz: String;
  cch: Integer;
begin
  FileName := 'c:\test.txt';

  FillChar(szSessionKey, SizeOf(szSessionKey), 0);
  SetLastError(RmStartSession(dwSession, 0, szSessionKey));
  Win32Check(GetLastError = ERROR_SUCCESS);
  try
    P := PWideChar(FileName);
    pszFile := @P;
    SetLastError(RmRegisterResources(dwSession, 1, pszFile, 0, nil, 0, nil));
    Win32Check(GetLastError = ERROR_SUCCESS);

    nProcInfo := Num;
    SetLastError(RmGetList(dwSession, nProcInfoNeeded, nProcInfo, rgpi[0], dwReason));
    Win32Check(GetLastError = ERROR_SUCCESS);

    for i := 0 to nProcInfo - 1 do
    begin
      ShowMessage(Format('%d.ApplicationType = %d (%s)',
        [i, Ord(rgpi[i].ApplicationType), StrFromAppType(rgpi[i].ApplicationType)]));
      ShowMessage(Format('%d.strAppName = %s', [i, rgpi[i].strAppName]));
      ShowMessage(Format('%d.Process.dwProcessId = %d', [i, rgpi[i].Process.dwProcessId]));

      hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, rgpi[i].Process.dwProcessId);
      if hProcess <> 0 then
      try
        if GetProcessTimes(hProcess, ftCreate, ftExit, ftKernel, ftUser) and
           (CompareFileTime(rgpi[i].Process.ProcessStartTime, ftCreate) = 0) then
        begin
          cch := MAX_PATH;
          SetLength(sz, cch);
          if QueryFullProcessImageName(hProcess, 0, PChar(sz), cch) and (cch <= MAX_PATH) then
          begin
            SetLength(sz, cch);
            ShowMessage(Format('%d.Process.Name = %s', [i, sz]));
          end;
        end;
      finally
        CloseHandle(hProcess);
      end;
    end;
  finally
    RmEndSession(dwSession);
  end;
end;


Как конвертировать файл в Base64 и обратно?

// Способ первый
uses
   Soap.EncdDecd;

procedure TForm1.Button1Click(Sender: TObject);
const
  b64 = 'iVBORw0KGgoAAAANSUhEUgAAAAkAAAAJCAYAA' +
        'ADgkQYQAAAANUlEQVQoU2PkLrj9n4EAYAQp+j' +
        'pBlRGXOpA8hiJ0TaQrwuY2kDNINwnmcKLchO5' +
        'LuHWEwgkAlO5FBwhFaI8AAAAASUVORK5CYII=';
var
  bs: TBytesStream;
begin
  bs := TBytesStream.Create(DecodeBase64(b64));
  try
    bs.SaveToFile('c:\tmp\tmp.png');
  finally
    bs.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  aStr: AnsiString;
  bs: TBytesStream;
  str: string;
begin
  bs := TBytesStream.Create;
  try
    bs.LoadFromFile('c:\tmp\tmp.png');
    aStr := EncodeBase64(bs.Memory, bs.Size);
    str := StringReplace(aStr, sLineBreak, '', [rfReplaceAll]);
  finally
    bs.Free;
  end;

  MessageBox(Handle, PChar(str), '', 0);
end;

// Способ второй
uses
  System.NetEncoding;

procedure TForm1.Button1Click(Sender: TObject);
const
  b64 = 'iVBORw0KGgoAAAANSUhEUgAAAAkAAAAJCAYAA' +
        'ADgkQYQAAAANUlEQVQoU2PkLrj9n4EAYAQp+j' +
        'pBlRGXOpA8hiJ0TaQrwuY2kDNINwnmcKLchO5' +
        'LuHWEwgkAlO5FBwhFaI8AAAAASUVORK5CYII=';
var
  bs: TBytesStream;
  b: TBytes;
begin
  bs := TBytesStream.Create;
  try
    b := TNetEncoding.Base64.DecodeStringToBytes(b64);
    bs.Write(b, Length(b));
    bs.SaveToFile('c:\tmp\tmp.png');
  finally
    bs.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  bs: TBytesStream;
  str: string;
begin
  bs := TBytesStream.Create;
  try
    bs.LoadFromFile('c:\tmp\tmp.png');
    str := TNetEncoding.Base64.EncodeBytesToString(bs.Bytes, bs.Size);
    str := StringReplace(str, sLineBreak, '', [rfReplaceAll]);
    MessageBox(Handle, PChar(str), '', 0);
  finally
    bs.Free;
  end;
end;

// Способ третий
uses
  IdCoder, IdCoderMIME;

procedure TForm1.Button1Click(Sender: TObject);
const
  b64 = 'iVBORw0KGgoAAAANSUhEUgAAAAkAAAAJCAYAA' +
        'ADgkQYQAAAANUlEQVQoU2PkLrj9n4EAYAQp+j' +
        'pBlRGXOpA8hiJ0TaQrwuY2kDNINwnmcKLchO5' +
        'LuHWEwgkAlO5FBwhFaI8AAAAASUVORK5CYII=';
var
  bs: TBytesStream;
  Decoder: TIdDecoderMIME;
begin
  bs := TBytesStream.Create;
  try
    Decoder := TIdDecoderMIME.Create;
    try
      Decoder.DecodeBegin(bs);
      Decoder.Decode(b64);
      Decoder.DecodeEnd;
    finally
      Decoder.Free;
    end;
    bs.SaveToFile('c:\tmp\tmp.png');
  finally
    bs.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  bs: TBytesStream;
  Encoder: TIdEncoderMIME;
  str: string;
begin
  bs := TBytesStream.Create;
  try
    bs.LoadFromFile('c:\tmp\tmp.png');
    Encoder := TIdEncoderMIME.Create;
    try
      str := Encoder.Encode(bs);
      MessageBox(Handle, PChar(str), '', 0);
    finally
      Encoder.Free;
    end;
  finally
    bs.Free;
  end;
end;


Как открыть файл в монопольном режиме?

// Способ первый
var
  f: TextFile;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FileMode := fmOpenRead or fmShareDenyNone;
  AssignFile(f, 'c:\test.txt');
  Reset(f);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CloseFile(f);
end;

// Способ второй
var
  h: NativeInt;

procedure TForm1.Button1Click(Sender: TObject);
begin
  h := FileOpen('c:\test.txt', fmOpenReadWrite or fmShareExclusive);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FileClose(h);
end;

// Способ третий
var
  h: HFILE;

procedure TForm1.Button1Click(Sender: TObject);
begin
  h := CreateFile(PChar('c:\test.txt'), GENERIC_READ or GENERIC_WRITE,
                  0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CloseHandle(h);
end;

// Способ четвертый
var
  fs: TFileStream;

procedure TForm1.Button1Click(Sender: TObject);
begin
  fs := TFileStream.Create('c:\test.txt', fmOpenReadWrite {or fmShareDenyNone});
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  fs.Free;
end;


Как получить список каталогов?

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
  isFound: Boolean;
  sRec: TSearchRec;
begin
  isFound := FindFirst('c:\*.*', faAnyFile, sRec) = 0;
  while isFound do
  begin
    if (sRec.Name <> '.') and
       (sRec.Name <> '..') and
       ((sRec.Attr and faDirectory) = faDirectory) then
      ShowMessage(sRec.Name);
    isFound := FindNext(sRec) = 0;
  end;
end;

// Способ второй
uses
  System.IOUtils, System.Types;
  
procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: string;
begin
  for FileName in TDirectory.GetDirectories('c:\') do
    ShowMessage(ExtractFileName(FileName));
end;


Как из-под Windows сохранить текстовый файл в формате Linux?

procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
begin
  sl := TStringList.Create;

  try
    sl.Add('Line1');
    sl.Add('Line2');
    sl.Add('Line3');

    sl.LineBreak := #10;
    // Добавить перенос после последней строки
    sl.TrailingLineBreak := True;
    // или
    // sl.Options := [soTrailingLineBreak];
    sl.SaveToFile('c:\TEMP\linux.txt');
  finally
    sl.Free;
  end;
end;


Как определить формат текстового файла, UNICODE или ANSI?

uses
  WideStrUtils;

procedure TForm1.Button3Click(Sender: TObject);
var
  str: RawByteString;
  ss: TStringStream;
  data: TBytes;
begin
  ss := TStringStream.Create;
  try
    ss.LoadFromFile('c:\test.txt');
    data := BytesOf(ss.DataString);
    str := AnSiString(data);
    if IsUTF8String(ss.DataString) then
      ShowMessage('UNICODE')
    else
      ShowMessage('ANSI');
  finally
    ss.Free;
  end;
end;

При использовании материала - ссылка на сайт обязательна