:: 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;
|
При использовании материала - ссылка на сайт обязательна
|
|