Автор: newfork

Склонение день, дня, дней

function lastDigitToWord(digit)
{
var lastFigure = parseInt(digit.toString().substr(digit.toString().length - 1, 1));
if (digit > 11 && digit < 15) { return 'Дней'; }
else { if (lastFigure == 1) return 'День'; if (lastFigure > 1 && lastFigure < 5) return 'Дня'; if (lastFigure == 0 || lastFigure >= 5) return 'Дней';
}

}

Выполнение

var days = [10, 13, 1, 25, 2, 5, 4, 344];
var result = '';
for (var i in days)
{
result += days[i].toString() + ' - ' + lastDigitToWord(days[i]) + '\n';
}

alert(result);

Перенос настройки подключений dbForge Studio for MySQL

Иногда возникает необходимость перенести настройки подключений dbForge Studio for MySQL с одного рабочего места на другое.

Это легко сделать скопировав ветку реестра HKEY_CURRENT_USER\SOFTWARE\Devart\dbForge Common Settings\Connections

MyDAC NULL is not a valid integer value for field…

Иногда при использовании компонент MyDAC, при вставке записи возникает ошибка типа NULL is not a valid integer value for field…
Чтобы её исправить, в свойствах компонента TMyQuery -> Options выставить параметр DefaultValues = False

Загрузить RTF файл из ресурса своего EXE

Load RTF file from resource:

You can store any kind of file as a RCDATA resource.

The following example shows this with an RTF file.

Create a text file called textres.rc and put the

following line in it:

TESTDOC RCDATA «textdoc.rtf»

Next, compile that using the Borland Resource Compiler,

which is provided with Delphi.

brcc32.exe textres.rc

Your next step is to include the compiled resource (.RES) file into

your executable, which can be done with the {$R} compiler directive.

*)

implementation

{$R *.dfm}

{$R textres.res} // <---- your resource file!

procedure TForm1.Button1Click(Sender: TObject);

var

rs: TResourceStream;

begin

rs := TResourceStream.Create(hinstance, 'TESTDOC', RT_RCDATA);

try

Richedit1.PlainText := False;

TempStream.Position := 0;

Richedit1.Lines.LoadFromStream(rs);

finally

rs.Free;

end;

end;

Получить количество файлов в корзине и их общий размер

type

PSHQueryRBInfo = ^TSHQueryRBInfo;

TSHQueryRBInfo = packed record

cbSize: DWORD;

// Size of the structure, in bytes.

// This member must be filled in prior to calling the function.

i64Size: Int64;

// Total size of all the objects in the specified Recycle Bin, in bytes.

i64NumItems: Int64;

// Total number of items in the specified Recycle Bin.

end;

const

shell32 = 'shell32.dll';

function SHQueryRecycleBin(szRootPath: PChar; SHQueryRBInfo: PSHQueryRBInfo): HResult;

stdcall; external shell32 Name 'SHQueryRecycleBinA';

function GetDllVersion(FileName: string): Integer;

var

InfoSize, Wnd: DWORD;

VerBuf: Pointer;

FI: PVSFixedFileInfo;

VerSize: DWORD;

begin

Result := 0;

InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);

if InfoSize 0 then

begin

GetMem(VerBuf, InfoSize);

try

if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then

if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then

Result := FI.dwFileVersionMS;

finally

FreeMem(VerBuf);

end;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

DllVersion: integer;

SHQueryRBInfo: TSHQueryRBInfo;

r: HResult;

begin

DllVersion := GetDllVersion(PChar(shell32));

if DllVersion >= $00040048 then

begin

FillChar(SHQueryRBInfo, SizeOf(TSHQueryRBInfo), #0);

SHQueryRBInfo.cbSize := SizeOf(TSHQueryRBInfo);

R := SHQueryRecycleBin(nil, @SHQueryRBInfo);

if r = s_OK then

begin

label1.Caption := Format('Size:%d Items:%d',

[SHQueryRBInfo.i64Size, SHQueryRBInfo.i64NumItems]);

end

else

label1.Caption := Format('Err:%x', [r]);

end;

end;

{

The SHQueryRecycleBin API used in this method is

only available on systems with the latest shell32.dll installed with IE4 /

Active Desktop.

}


[cc lang="delphi"] 

Переслать файл в Корзину

Сначала нужно в директиве uses подключить модуль ShellAPI, чтобы мы смогли воспользоваться API-функцией SHFileOperation(). А затем уже можно использовать такой вот процедурой:

procedure SendToPomoyka(FileName: string);

var

SHF: TSHFileOpStruct;

begin

with SHF do

begin

Wnd := Application.Handle;

wFunc := FO_DELETE;

pFrom := PChar(FileName);

fFlags := FOF_SILENT or FOF_ALLOWUNDO;

end;

SHFileOperation(SHF);

end;

Очистить корзину

procedure EmptyRecycleBin;

const

SHERB_NOCONFIRMATION = $00000001;

SHERB_NOPROGRESSUI = $00000002;

SHERB_NOSOUND = $00000004;

type

TSHEmptyRecycleBin = function(Wnd: HWND;

pszRootPath: PChar;

dwFlags: DWORD): HRESULT; stdcall;

var

SHEmptyRecycleBin: TSHEmptyRecycleBin;

LibHandle: THandle;

begin { EmptyRecycleBin }

LibHandle := LoadLibrary(PChar('Shell32.dll'));

if LibHandle 0 then @SHEmptyRecycleBin :=

GetProcAddress(LibHandle, 'SHEmptyRecycleBinA')

else

begin

MessageDlg('Failed to load Shell32.dll.', mtError, [mbOK], 0);

Exit;

end;

if @SHEmptyRecycleBin nil then

SHEmptyRecycleBin(Application.Handle,

nil,

SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI or SHERB_NOSOUND);

FreeLibrary(LibHandle); @SHEmptyRecycleBin := nil;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

EmptyRecycleBin;

end;

{

Minimum operating systems: Windows XP/2000, Windows NT 4.0 with Internet Explorer 4.0,

Windows 98, Windows 95 with Internet Explorer 4.0

(shell32.dll version 4.71 or later)

}

Копирование директорий и удаление директорий в корзину

unit MainFrm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons;

type

TMainForm = class(TForm)

GroupBox1: TGroupBox;

spbtnGetFromDir: TSpeedButton;

spbtnGetToDir: TSpeedButton;

edtFromDir: TEdit;

edtToDir: TEdit;

Button1: TButton;

GroupBox2: TGroupBox;

edtRecycleDir: TEdit;

spbtnRecycleBin: TSpeedButton;

btnRecycleDir: TButton;

btnClose: TButton;

procedure spbtnGetFromDirClick(Sender: TObject);

procedure spbtnGetToDirClick(Sender: TObject);

procedure btnCopyDirectoryClick(Sender: TObject);

procedure spbtnRecycleBinClick(Sender: TObject);

procedure btnRecycleDirClick(Sender: TObject);

procedure btnCloseClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

MainForm: TMainForm;

implementation

uses ShellAPI, FileCtrl;

{$R *.DFM}

function GetDirectory: string;

begin

if not SelectDirectory(Result, [sdAllowCreate, sdPerformCreate, sdPrompt], 0)

then

Result := EmptyStr;

end;

procedure CopyDirectoryTree(AHandle: THandle; const AFromDirectory,

AToDirectory: string);

var

SHFileOpStruct: TSHFileOpStruct;

FromDir: PChar;

ToDir: PChar;

begin

GetMem(FromDir, Length(AFromDirectory) 2);

try

GetMem(ToDir, Length(AToDirectory) 2);

try

FillChar(FromDir^, Length(AFromDirectory) 2, 0);

FillChar(ToDir^, Length(AToDirectory) 2, 0);

StrCopy(FromDir, PChar(AFromDirectory));

StrCopy(ToDir, PChar(AToDirectory));

with SHFileOpStruct do

begin

Wnd := AHandle; // Assign the window handle

wFunc := FO_COPY; // Specify a file copy

pFrom := FromDir;

pTo := ToDir;

fFlags := FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;

fAnyOperationsAborted := False;

hNameMappings := nil;

lpszProgressTitle := nil;

if SHFileOperation(SHFileOpStruct) 0 then

RaiseLastWin32Error;

end;

finally

FreeMem(ToDir, Length(AToDirectory) 2);

end;

finally

FreeMem(FromDir, Length(AFromDirectory) 2);

end;

end;

procedure ToRecycle(AHandle: THandle; const ADirName: string);

var

SHFileOpStruct: TSHFileOpStruct;

DirName: PChar;

BufferSize: Cardinal;

begin

BufferSize := Length(ADirName) 1 1;

GetMem(DirName, BufferSize);

try

FillChar(DirName^, BufferSize, 0);

StrCopy(DirName, PChar(ADirName));

with SHFileOpStruct do

begin

Wnd := AHandle;

wFunc := FO_DELETE;

pFrom := DirName;

pTo := nil;

fFlags := FOF_ALLOWUNDO;

fAnyOperationsAborted := False;

hNameMappings := nil;

lpszProgressTitle := nil;

end;

if SHFileOperation(SHFileOpStruct) 0 then

RaiseLastWin32Error;

finally

FreeMem(DirName, BufferSize);

end;

end;

procedure TMainForm.spbtnGetFromDirClick(Sender: TObject);

begin

edtFromDir.Text := GetDirectory;

end;

procedure TMainForm.spbtnGetToDirClick(Sender: TObject);

begin

edtToDir.Text := GetDirectory;

end;

procedure TMainForm.btnCopyDirectoryClick(Sender: TObject);

begin

CopyDirectoryTree(Handle, edtFromDir.Text, edtToDir.Text);

end;

procedure TMainForm.spbtnRecycleBinClick(Sender: TObject);

begin

edtRecycleDir.Text := GetDirectory;

end;

procedure TMainForm.btnRecycleDirClick(Sender: TObject);

begin

ToRecycle(0, edtRecycleDir.Text);

end;

procedure TMainForm.btnCloseClick(Sender: TObject);

begin

Close;

end;

end.

Как удалить файлы из корзины

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.

Восстановление

Есть некоторые причуды, и Вы должны помнить о следующем:

Дайте полный путь для каждого файла. Не доверяйте текущей директории, даже если Вы ее изменили непосредственно перед вызовом функции. Функция WinAPI SHFileOperation не достаточно «умная» для использования текущей директории при отсутствии информации о предыдущей директории (для осуществления функции восстановления). Так, даже если используете флаг FOF_ALLOWUNDO, это не восстановит удаленные файлы из корзины, поскольку функция ничего не знает о предыдущем месторасположении файлов, и, таким образом, не сможет их восстановить файлы из корзины в их оригинальное месторасположение. Она просто удалит файлы из текущей директории.

Microsoft скорректировала документацию о члене pFrom. Новая редакция сообщает о подробностях работы в пакетном режиме: необходимо разделить имя каждого файла символом NULL (#0) и добавить к концу списка двойной символ NULL. Терминатор из двух символов NULL необходим в любом случае: работаете вы с одним файлом, или же используете пакетный режим. Иногда это работает и без терминатора, но чаще нет. Это связано с тем, что функции при работе с памятью считывает данные из памяти, располагающейся до терминатора, а поскольку длина строки может не совпадать с распределенной памятью, то данные, находящиеся после терминатора, просто не обрабатываются.

Пример правильного кодирования:

var

FileList: string;

FOS: TShFileOpStruct;

begin

FileList := 'c:\delete.me'#0'c:\windows\temp.$$$'#0#0;

{ если Вы используете имена файлов в строковых переменных: }

FileList := Filename1 #0 Filename2 #0#0;

FOS.pFrom := PChar(FileList);

end;

Управление метками томов дисков

Данный совет содержит исходный код модуля, который может помочь Вам получить, установить и удалить метку тома гибкого или жесткого диска. Код получения метки тома содержит функцию Delphi FindFirst, код для установки и удаления метки тома использует вызов DOS-прерывания 21h и функции 16h и 13h соответственно. Поскольку функция 16h не поддерживается Windows, она должна вызываться через DPMI-прерывание 31h, функцию 300h.

{ *** НАЧАЛО КОДА МОДУЛЯ VOLLABEL *** }

unit VolLabel;

interface

uses Classes, SysUtils, WinProcs;

type

EInterruptError = class(Exception);

EDPMIError = class(EInterruptError);

Str11 = string[11];

procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);

function GetVolumeLabel(Drive: Char): Str11;

procedure DeleteVolumeLabel(Drv: Char);

implementation

type

PRealModeRegs = ^TRealModeRegs;

TRealModeRegs = record

case Integer of

0: (

EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;

Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);

1: (

DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;

case Integer of

0: (

BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);

1: (

BL, BH, BLH, BHH, DL, DH, DLH, DHH,

CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));

end;

PExtendedFCB = ^TExtendedFCB;

TExtendedFCB = record

ExtendedFCBflag: Byte;

Reserved1: array[1..5] of Byte;

Attr: Byte;

DriveID: Byte;

FileName: array[1..8] of Char;

FileExt: array[1..3] of Char;

CurrentBlockNum: Word;

RecordSize: Word;

FileSize: LongInt;

PackedDate: Word;

PackedTime: Word;

Reserved2: array[1..8] of Byte;

CurrentRecNum: Byte;

RandomRecNum: LongInt;

end;

procedure RealModeInt(Int: Byte; var Regs: TRealModeRegs);

{ процедура работает с прерыванием 31h, функцией 0300h для иммитации }

{ прерывания режима реального времени для защищенного режима. }

var

ErrorFlag: Boolean;

begin

asm

mov ErrorFlag, 0 { успешное завершение }

mov ax, 0300h { функция 300h }

mov bl, Int { прерывание режима реального времени, которое необходимо выполнить }

mov bh, 0 { требуется }

mov cx, 0 { помещаем слово в стек для копирования, принимаем ноль }

les di, Regs { es:di = Regs }

int 31h { DPMI-прерывание 31h }

jnc @@End { адрес перехода установлен в error }

@@Error:

mov ErrorFlag, 1 { возвращаем false в error }

@@End:

end;

if ErrorFlag then

raise EDPMIError.Create('Неудача при выполнении DPMI-прерывания');

end;

function DriveLetterToNumber(DriveLet: Char): Byte;

{ функция преобразования символа буквы диска в цифровой эквивалент. }

begin

if DriveLet in ['a'..'z'] then

DriveLet := Chr(Ord(DriveLet) - 32);

if not (DriveLet in ['A'..'Z']) then

raise

EConvertError.CreateFmt('Не могу преобразовать %s в числовой эквивалент диска',

[DriveLet]);

Result := Ord(DriveLet) - 64;

end;

procedure PadVolumeLabel(var Name: Str11);

{ процедура заполнения метки тома диска строкой с пробелами }

var

i: integer;

begin

for i := Length(Name) 1 to 11 do

Name := Name ' ';

end;

function GetVolumeLabel(Drive: Char): Str11;

{ функция возвращает метку тома диска }

var

SR: TSearchRec;

DriveLetter: Char;

SearchString: string[7];

P: Byte;

begin

SearchString := Drive ':\*.*';

{ ищем метку тома }

if FindFirst(SearchString, faVolumeID, SR) = 0 then

begin

P := Pos('.', SR.Name);

if P > 0 then

begin { если у него есть точка... }

Result := ' '; { пространство между именами }

Move(SR.Name[1], Result[1], P - 1); { и расширениями }

Move(SR.Name[P 1], Result[9], 3);

end

else

begin

Result := SR.Name; { в противном случае обходимся без пробелов }

PadVolumeLabel(Result);

end;

end

else

Result := '';

end;

procedure DeleteVolumeLabel(Drv: Char);

{ процедура удаления метки тома с данного диска }

var

CurName: Str11;

FCB: TExtendedFCB;

ErrorFlag: WordBool;

begin

ErrorFlag := False;

CurName := GetVolumeLabel(Drv); { получение текущей метки тома }

FillChar(FCB, SizeOf(FCB), 0); { инициализируем FCB нулями }

with FCB do

begin

ExtendedFCBflag := $FF; { всегда }

Attr := faVolumeID; { Аттрибут Volume ID }

DriveID := DriveLetterToNumber(Drv); { Номер диска }

Move(CurName[1], FileName, 8); { необходимо ввести метку тома }

Move(CurName[9], FileExt, 3);

end;

asm

push ds { сохраняем ds }

mov ax, ss { помещаем сегмент FCB (ss) в ds }

mov ds, ax

lea dx, FCB { помещаем смещение FCB в dx }

mov ax, 1300h { функция 13h }

Call DOS3Call { вызываем int 21h }

pop ds { восстанавливаем ds }

cmp al, 00h { проверка на успешность выполнения }

je @@End

@@Error: { устанавливаем флаг ошибки }

mov ErrorFlag, 1

@@End:

end;

if ErrorFlag then

raise EInterruptError.Create('Не могу удалить имя тома');

end;

procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);

{ процедура присваивания метки тома диска. Имейте в виду, что }

{ данная процедура удаляет текущую метку перед установкой новой. }

{ Это необходимое требование для функции установки метки. }

var

Regs: TRealModeRegs;

FCB: PExtendedFCB;

Buf: Longint;

begin

PadVolumeLabel(NewLabel);

if GetVolumeLabel(Drive) '' then { если имеем метку... }

DeleteVolumeLabel(Drive); { удаляем метку }

Buf := GlobalDOSAlloc(SizeOf(PExtendedFCB)); { распределяем реальный буфер }

FCB := Ptr(LoWord(Buf), 0);

FillChar(FCB^, SizeOf(FCB), 0); { инициализируем FCB нулями }

with FCB^ do

begin

ExtendedFCBflag := $FF; { требуется }

Attr := faVolumeID; { Аттрибут Volume ID }

DriveID := DriveLetterToNumber(Drive); { Номер диска }

Move(NewLabel[1], FileName, 8); { устанавливаем новую метку }

Move(NewLabel[9], FileExt, 3);

end;

FillChar(Regs, SizeOf(Regs), 0);

with Regs do

begin { Сегмент FCB }

ds := HiWord(Buf); { отступ = ноль }

dx := 0;

ax := $1600; { Функция 16h }

end;

RealModeInt($21, Regs); { создаем файл }

if (Regs.al 0) then { проверка на успешность выполнения }

raise EInterruptError.Create('Не могу создать метку тома');

end;

end.

{ *** КОНЕЦ КОДА МОДУЛЯ VOLLABEL *** }