|
:: MVP ::
|
|
|
:: RSS ::
|
|
|
Как связать определённое расширение файлов с моим приложением?
uses
{...,} Registry;
procedure Registration(FileType, // Тип файла (расширение)
FileTypeName, // Имя
Description, // Описание
ExecCommand, // Путь к запускному файлу
Index: string); // Индекс иконки
var
reg: TRegistry;
begin
if (FileType = '') or (FileTypeName = '') or (ExecCommand = '') then
Exit;
if FileType[1] <> '.' then
FileType := '.' + FileType;
if Description = '' then
Description := FileTypeName;
reg := TRegistry.Create;
try
with Reg do
begin
RootKey := HKEY_CLASSES_ROOT;
OpenKey(FileType, True);
WriteString('', FileTypeName);
CloseKey;
OpenKey(FileTypeName, True);
WriteString('', Description);
CloseKey;
OpenKey(FileTypeName + '\DefaultIcon', True);
WriteString('', ExecCommand + ', ' + Index);
CloseKey;
OpenKey(FileTypeName + '\Shell\Open\Command', True);
WriteString('', ExecCommand + ' %1');
end;
finally
reg.Free;
end;
end;
procedure TMainFrm.BitBtn1Click(Sender: TObject);
begin
Registration('fs', 'fsBase', 'fs Base', Application.ExeName, '0');
end;
|
Как обнаружить активность пользователя?
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
procedure DoMessageEvent( var Msg: TMsg; var Handled: Boolean );
{...}
end;
procedure TForm1.DoMessageEvent(var Msg: TMsg; var Handled: Boolean);
begin
case Msg.message of
WM_KEYFIRST..WM_KEYLAST, WM_MOUSEFIRST..WM_MOUSELAST:
begin
// Произошло событие клавиатуры или мыши,
// делаем все, что нам надо
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := DoMessageEvent;
end;
|
Как сгенерировать GUID и перевести в строку?
// GUID (Globally Unique IDentifier).
// Это уникальный идентификатор.
// Берется текущее время, номер сетевой карточки и генерится GUID.
// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
GUID: TGUID;
begin
CreateGUID(GUID);
Caption := GUIDToString(GUID);
end;
// Способ второй
uses
{...,} ActiveX;
procedure TForm1.Button1Click(Sender: TObject);
var
GUID: TGUID;
begin
if CoCreateGuid(GUID) = S_OK then
Caption := GUIDToString(GUID);
end;
// Способ третий
uses
{...,} ComObj;
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := CreateClassID;
end;
// Перевести строку в GUID можно следующим образом.
procedure TForm1.Button2Click(Sender: TObject);
const
s = '{821AB2C7-559D-48E0-A3EE-6DD50E83234C}';
var
GUID: TGUID;
begin
GUID := StringToGUID(s);
end;
|
Как конвертировать арабское число в римское?
// Способ первый
function IntToRoman(num: Cardinal): string;
const
N = 13;
vals: array [1..N] of Word =
(1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
roms: array [1..N] of string[2] =
('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
b: 1..N;
begin
Result := '';
b := N;
while num > 0 do
begin
while vals[b] > num do
Dec(b);
Dec(num, vals[b]);
Result := Result + roms[b];
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToRoman(1561));
end;
// Способ второй
function IntToRoman(num: Cardinal): string;
const
N = 13;
vals: array [1..N] of Word =
(1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
roms: array [1..N] of string[2] =
('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
b: 1..N;
begin
Result := '';
b := N;
while (num > 0) and (b >= 1) do
begin
if num >= vals[b] then
begin
Result := Result + roms[b];
Dec(num, vals[b]);
end
else
Dec(b);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToRoman(1561));
end;
// Способ третий
function IntToRoman(Value: Longint): string;
Label
A500, A400, A100, A90, A50, A40, A10, A9, A5, A4, A1;
begin
Result := '';
while Value >= 1000 do
begin
Dec(Value, 1000);
Result := Result + 'M';
end;
if Value < 900 then
goto A500
else
begin
Dec(Value, 900);
Result := Result + 'CM';
end;
goto A90;
A400:
if Value < 400 then
goto A100
else
begin
Dec(Value, 400);
Result := Result + 'CD';
end;
goto A90;
A500:
if Value < 500 then
goto A400
else
begin
Dec(Value, 500);
Result := Result + 'D';
end;
A100:
while Value >= 100 do
begin
Dec(Value, 100);
Result := Result + 'C';
end;
A90:
if Value < 90 then
goto A50
else
begin
Dec(Value, 90);
Result := Result + 'XC';
end;
goto A9;
A40:
if Value < 40 then
goto A10
else
begin
Dec(Value, 40);
Result := Result + 'XL';
end;
goto A9;
A50:
if Value < 50 then
goto A40
else
begin
Dec(Value, 50);
Result := Result + 'L';
end;
A10:
while Value >= 10 do
begin
Dec(Value, 10);
Result := Result + 'X';
end;
A9:
if Value < 9 then
goto A5
else
Result := Result + 'IX';
Exit;
A4:
if Value < 4 then
goto A1
else
Result := Result + 'IV';
Exit;
A5:
if Value < 5 then
goto A4
else
begin
Dec(Value, 5);
Result := Result + 'V';
end;
goto A1;
A1:
while Value >= 1 do
begin
Dec(Value);
Result := Result + 'I';
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToRoman(1561))
end;
|
Как сделать аналог процедуры Delay в Delphi?
// Способ первый
procedure Delay(MSec: LongInt);
var
FirstTick: Longint;
begin
FirstTick := GetTickCount;
repeat
Application.ProcessMessages;
until GetTickCount - FirstTick >= MSec;
end;
// Способ второй
procedure Delay(MSec: LongInt);
var
FirstTick: Longint;
begin
FirstTick := GetMessageTime;
repeat
Application.ProcessMessages;
until GetTickCount - FirstTick >= MSec;
end;
// Способ третий
procedure Delay(ATimeout: Integer);
var
t: Cardinal;
begin
while ATimeout > 0 do
begin
t := GetTickCount;
if MsgWaitForMultipleObjects(0, nil^, False, ATimeOut, QS_ALLINPUT) = WAIT_TIMEOUT then
Exit;
Application.ProcessMessages;
Dec(ATimeout, GetTickCount-t);
end;
end;
|
Как получить список инсталлированных програм?
uses
{...,} Registry;
procedure TForm1.FormCreate(Sender: TObject);
begin
with ListView1 do
begin
ViewStyle := vsReport;
Columns.Add;
Columns.Add;
Columns[0].Caption := 'DisplayName';
Columns[0].Width := 300;
Columns[1].Caption := 'UninstallString';
Columns[1].Width := 300;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
UNINST_PATH = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall';
var
Reg: TRegistry;
SubKeys: TStringList;
ListItem: TlistItem;
i: Integer;
sDisplayName, sUninstallString: string;
begin
Reg := TRegistry.Create;
with Reg do
try
with ListView1.Items do
try
BeginUpdate;
Clear;
RootKey := HKEY_LOCAL_MACHINE;
if OpenKeyReadOnly(UNINST_PATH) then
begin
SubKeys := TStringList.Create;
try
GetKeyNames(SubKeys);
CloseKey;
for i := 0 to SubKeys.Count-1 do
if OpenKeyReadOnly(Format('%s\%s', [UNINST_PATH,SubKeys[i]])) then
try
sDisplayName := ReadString('DisplayName');
sUninstallString := ReadString('UninstallString');
if sDisplayName <> '' then
begin
ListItem := Add;
ListItem.Caption := sDisplayName;
ListItem.subitems.Add(sUninstallString);
end;
finally
CloseKey;
end;
finally
SubKeys.Free;
end;
end;
finally
ListView1.AlphaSort;
EndUpdate;
end;
finally
CloseKey;
Free;
end;
end;
|
Как проверить корректность номера банковской карты?
// Способ первый
//----------------------------------------------------------------------
// Проверка корректности номера банковской карты по алгоритму Луна
//----------------------------------------------------------------------
// 1. Цифры проверяемой последовательности нумеруются справа налево.
// 2. Цифры, оказавшиеся на нечетных местах, остаются без изменений.
// 3. Цифры, стоящие на четных местах, умножаются на 2.
// 4. Если в результате такого умножения возникает число больше 9,
// оно заменяется суммой цифр получившегося произведения -
// однозначным числом, то есть цифрой.
// 5. Все полученные в результате преобразования цифры складываются.
// Если сумма кратна 10, то исходные данные верны.
//----------------------------------------------------------------------
function CheckCardNumber(str: string): Boolean;
var
i, chk, tmp: Integer;
arr: array of Integer;
begin
for i := Length(str) downto 1 do
if (str[i] < '0') or (str[i] > '9') then
Delete(str, i, 1);
chk := 0;
SetLength(arr, Length(str));
for i := Length(str) downto 1 do
begin
arr[chk] := StrToInt(str[i]);
Inc(chk);
end;
chk := 0;
for i := Low(arr) to High(arr) do
begin
tmp := arr[i] * (1 + i mod 2);
if tmp > 9 then
chk := chk + (tmp - 9)
else
chk := chk + tmp;
end;
Result := chk mod 10 = 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(BoolToStr(CheckCardNumber('4276 8770 1103 5748'))); // True
ShowMessage(BoolToStr(CheckCardNumber('4346-7820-0751-9190'))); // True
ShowMessage(BoolToStr(CheckCardNumber('67619600 0029070555'))); // True
ShowMessage(BoolToStr(CheckCardNumber('67619600 0000551045'))); // True
ShowMessage(BoolToStr(CheckCardNumber('63900238 9016596165'))); // True
ShowMessage(BoolToStr(CheckCardNumber('1234 5678 1234 5678'))); // False
end;
// Способ второй
uses
RegularExpressions, StrUtils, Math;
//----------------------------------------------------------------------
// Проверка корректности номера банковской карты по алгоритму Луна
//----------------------------------------------------------------------
// 1. Цифры проверяемой последовательности нумеруются справа налево.
// 2. Цифры, оказавшиеся на нечетных местах, остаются без изменений.
// 3. Цифры, стоящие на четных местах, умножаются на 2.
// 4. Если в результате такого умножения возникает число больше 9,
// оно заменяется суммой цифр получившегося произведения -
// однозначным числом, то есть цифрой.
// 5. Все полученные в результате преобразования цифры складываются.
// Если сумма кратна 10, то исходные данные верны.
//----------------------------------------------------------------------
function CheckCardNumber(Number: string): Boolean;
const
Pattern = '\D'; // [^0-9]
var
i, chk, tmp: Integer;
begin
Number := ReverseString(TRegEx.Replace(Number, Pattern, ''));
chk := 0;
tmp := 0;
for i := 1 to Length(Number) do
begin
tmp := StrToInt(Number[i]) * (1 + (i+1) mod 2);
chk := chk + tmp - IfThen(tmp > 9, 9, 0);
end;
Result := chk mod 10 = 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if CheckCardNumber('1234 5678 1234 5678') then
ShowMessage('Номер корректен');
end;
// Способ третий
{-------------------------------------------------
Returns:
0 : Card is invalid or unknown
1 : Card is a valid AmEx
2 : Card is a valid Visa
3 : Card is a valid MasterCard
-------------------------------------------------}
function CheckCC(c: string): Integer;
var
card: string[21];
Vcard: array[0..20] of Byte absolute card;
Xcard: Integer;
Cstr: string[21];
y, x: Integer;
begin
Cstr := '';
FillChar(Vcard, 22, #0);
card := c;
for x := 1 to 20 do
if Vcard[x] in [48..57] then
Cstr := Cstr + Chr(Vcard[x]);
card := '';
card := Cstr;
Xcard := 0;
if not Odd(Length(card)) then
for x := Length(card)-1 downto 1 do
begin
if Odd(x) then
y := (Vcard[x] - 48) * 2
else
y := Vcard[x] - 48;
if y >= 10 then
y := y - 10 + 1;
Xcard := Xcard + y;
end
else
for x := Length(card)-1 downto 1 do
begin
if Odd(x) then
y := Vcard[x] - 48
else
y := (Vcard[x] - 48) * 2;
if y >= 10 then
y := y - 10 + 1;
Xcard := Xcard + y;
end;
x := 10 - (Xcard mod 10);
if x = 10 then
x := 0;
if x = Vcard[Length(card)] - 48 then
Result := Ord(Cstr[1]) - Ord('2')
else
Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
case CheckCC( '4276 8770 1103 5748' ) of
0: Caption := 'Card is invalid or unknown';
1: Caption := 'Card is a valid AmEx';
2: Caption := 'Card is a valid Visa';
3: Caption := 'Card is a valid MasterCard';
end;
end;
|
Как поменять значения числовых переменных местами?
// Способ первый (с использованием дополнительной переменной)
procedure TForm1.Button1Click(Sender: TObject);
var
a, b, c: Integer;
begin
a := -2;
b := 3;
c := a;
a := b;
b := c;
ShowMessage('a = ' + IntToStr(a) + #13 + 'b = ' + IntToStr(b));
end;
// Способ второй (без использования дополнительной переменной)
procedure TForm1.Button1Click(Sender: TObject);
var
a, b: Integer;
begin
a := -2;
b := 3;
a := a + b;
b := a - b;
a := a - b;
ShowMessage('a = ' + IntToStr(a) + #13 + 'b = ' + IntToStr(b));
end;
// Способ третий (без использования дополнительной переменной)
procedure TForm1.Button1Click(Sender: TObject);
var
a, b: Integer;
begin
a := -2;
b := 3;
a := a xor b;
b := a xor b;
a := a xor b;
ShowMessage('a = ' + IntToStr(a) + #13 + 'b = ' + IntToStr(b));
end;
|
Как проверить правильность номера ISBN?
// ISBN (International Standard Book Numbers) - стандартный международный номер книги.
// ISBN имеет длину тринадцать символов, которые могут быть цифрами от 0 до 9, дефисом
// или буквой «X». Этот код состоит из четырех частей (между которыми стоит дефис):
// идентификатор группы, идентификатор издателя, идентификатор книги для издателя и
// контрольная цифра. Первая часть (идентификатор группы) используется для обозначения
// страны, географического региона, языка и пр. Вторая часть (идентификатор издателя)
// однозначно идентифицирует издателя. Третья часть (идентификатор книги) однозначно
// идентифицирует данную книгу среди коллекции книг, выпущенных данным издателем.
// Четвертая, заключительная часть (контрольная цифра), используется в коде алгоритма
// другими цифрами для получения поддающегося проверке ISBN. Количество цифр,
// содержащихся в первых трех частях, может быть различным, но контрольная цифра всегда
// содержит один символ (расположенный между «0» и «9» включительно, или «X» для
// величины 10). Таким образом, ISBN имеет длину тринадцать символов (десять чисел
// плюс три дефиса, разделяющих три части ISBN).
//
// ISBN 3-88053-002-5 можно разложить на части следующим образом:
// Группа: 3
// Издатель: 88053
// Книга: 002
// Контрольная цифра: 5
//
// ISBN можно проверить на правильность кода с помощью простого математического
// алгоритма. Суть его в следующем: нужно взять каждую из девяти цифр первых трех
// частей ISBN (пропуская дефисы), умножить каждую отдельную цифру на ее позицию в
// коде ISBN (считая справа от контрольной цифры), сложить эти произведения и прибавить
// контрольную цифру, после чего разделить получившееся число на одиннадцать. Если после
// процедуры деления остатка нет (т. е. число по модулю 11 делится без остатка),
// кандидат на ISBN является верным кодом ISBN. Например, используем предыдущий образец
// ISBN 3-88053-002-5:
//
// ISBN: 3 8 8 0 5 3 0 0 2 5
// Множитель: 10 9 8 7 6 5 4 3 2 1
// Продукт: 30+72+64+00+30+15+00+00+04+05 = 220
//
// Поскольку 220 на одиннадцать делится без остатка, рассмотренный в примере
// кандидат на ISBN является верным кодом ISBN.
function IsISBN(ISBN: string): Boolean;
var
Number, CheckDigit: string;
CheckValue, CheckSum, Err: Integer;
i, Cnt: Word;
begin
// Получаем контрольную цифру
CheckDigit := Copy(ISBN, Length(ISBN), 1);
// Получаем остальную часть, ISBN минус контрольная цифра и дефис
Number := Copy(ISBN, 1, Length(ISBN)-2);
// Длина разницы ISBN должны быть 11 и контрольная цифра между 0 и 9, или X
if (Length(Number) = 11) and (Pos(CheckDigit, '0123456789X') > 0) then
begin
// Получаем числовое значение контрольной цифры
if CheckDigit = 'X' then
CheckSum := 10
else
Val(CheckDigit, CheckSum, Err);
// Извлекаем в цикле все цифры из кода ISBN, применяя алгоритм декодирования
Cnt := 1;
for i := 1 to 11 do
begin
// Действуем, если текущий символ находится между "0" и "9", исключая дефисы
if Pos(Number[i], '0123456789') > 0 then
begin
Val(Number[i], CheckValue, Err);
// Алгоритм для каждого символа кода ISBN, Cnt - n-й обрабатываемый символ
CheckSum := CheckSum + CheckValue * (11 - Cnt);
Inc(Cnt);
end;
end;
// Проверяем делимость без остатка полученного значения на 11
Result := CheckSum mod 11 = 0;
end
else
Result := False;
end;
|
|
При использовании материала - ссылка на сайт обязательна
|
|
