Современные решения

для защиты Windows приложений

и восстановления исходного кода

Обсуждение программирования на Delphi в конференции ru.delphi


ru.delphi FAQ [6-10]

Q-111: Чем отличаются TLabel и TStaticText?
TLabel is TGraphicControl
TStaticText is TWinControl

То есть у последнего есть окно, это дает возможность управлять этим
контролом с помощью сообщений Windows.

Q-112: Как издать звук через PC Speaker?
// Для HТ вызов функции из ОС, для 9x прямое обращение к портам

Procedure BeepEx(Freq: Word; Duration: Integer);
var
Ver: TOsVersionInfo;
begin
Ver.dwOSVersionInfoSize := SizeOf(Ver);
GetVersionEx(Ver);
if Ver.dwPlatformId = VER_PLATFORM_WIN32_NT then
Windows.Beep(Freq, Duration)
else begin
asm
movzx ecx, Freq
mov eax, 1193180 // тактовая частота
sub edx, edx
div ecx // преобразование частоты в делитель
mov ecx, eax
mov al,0b6H
out 43H,al // управляющие слово
mov al,cl
out 42h,al // младший байт делителя
mov al,ch
out 42h,al // старший байт делителя
in al,61H
or al,03H
out 61H,al // включить звук
end;
sleep(Duration); // пауза на время звучани
asm
in al,61H
and al,0fcH
out 61H,al // выключить звук по окончанию Duration
end;
end;
end;

Q-113: Как корректнее завершать приложение- Terminate или MainForm.Close?
Terminate очень грубый метод. Если вызывать Application.Terminate, то не
сработают обработчики OnCloseQuery, OnClose главной формы.

Q-114: Как узнать версию Windows?
Использовать функцию API GetVersionEx

function GetVersionEx(var lpVersionInformation: TOSVersionInfo): BOOL;
stdcall;

Аргумент функции - структура TOSVersionInfo, содержит
dwVersionInfoSize:DWORD - заполняется как sizeof TOSVersionInfo) перед
вызовом функции

dwMajorVersion:DWORD - старшая цифра версии Windows
Windows 95 - 4
Windows 98 - 4
Windows Me - 4
Windows NT 3.51 - 3
Windows NT 4.0 - 4
Windows 2000 - 5
Windows XP - 5

dwMinorVersion: DWORD - младшая цифра версии
Windows 95 - 0
Windows 98 - 10
Windows Me - 90
Windows NT 3.51 - 51
Windows NT 4.0 - 0
Windows 2000 - 0
Windows XP - 1

dwBuildNumber: DWORD
Win NT 4 - номер билда
Win 9x - старший байт - старшая и младшая цифры версии / младший - номер
билда

dwPlatformId: DWORD
VER_PLATFORM_WIN32s Win32s on Windows 3.1.
VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 9x
VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000

szCSDVersion:DWORD
NT - содержит PСhar с инфо о установленном ServicePack
9x - доп. инфо, может и не быть

Alexander Kramarenko <kram [@] beep.ru>

++++++++++++++++++++++++++++++++++++++++++++++++++++

type
TWinVersion = (wvUnknown,wv95,wv98,wvME,wvNT3,wvNT4,wvW2K,wvXP);

function DetectWinVersion : TWinVersion;
var
OSVersionInfo : TOSVersionInfo;
begin
Result := wvUnknown;
OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
if GetVersionEx(OSVersionInfo) then begin
case OSVersionInfo.DwMajorVersion of
3: Result := wvNT3;
4: case OSVersionInfo.DwMinorVersion of
0: if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT
then Result := wvNT4
else Result := wv95;
10: Result := wv98;
90: Result := wvME;
end;
5: case OSVersionInfo.DwMinorVersion of
0: Result := wvW2K;
1: Result := wvXP;
end;
end;
end;
end;

function DetectWinVersionStr : string;
const
VersStr : array[TWinVersion] of string = (
'Unknown',
'Windows 95',
'Windows 98',
'Windows ME',
'Windows NT 3',
'Windows NT 4',
'Windows 2000',
'Windows XP');
begin
Result := VersStr[DetectWinVersion];
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Ver := DetectWinVersion;
Label1.Caption := IntToStr(Ord(DetectWinVersion));
Label2.Caption := DetectWinVersionStr;
end;

Анатолий Подгорецкий
+++++++++++++++++++++++++++++++

глобальные переменные Win32Platform (в справке),
Win32MajorVersion,
Win32MinorVersion,
Win32BuildNumber (в модуле SysUtils).

Инициализируются они автоматически, остается только проверить их.

Юрий Зотов
-+++++++++++++++++++++++++++++

DA> Может комy известен способ отличить Windows 2000 Server от Wks?


HKLM\System\CurrentControlSet\Control\ProductOptions
ProductType:REG_SZ (WinNT - Prof, ServerNT - Server, LanmanNT - сервер и
контроллер домена).
Именно по этому ключику сама винда определяет.
Это также относится и к NT4 (а может и ко всему остальному)
++++++++++++++++++++++++++++++

DA> Может комy известен способ отличить Windows 2000 Server от Wks?


Для определения версии Windows используем API-функцию
GetVersionEx(pOSVersionInfo), где pOSVersionInfo - указатель на структуру
следующего вида:

type
TOSVersionInfoEx = record
OsVersionInfoSize: DWORD; {Размер структуры типа TOSVersionInfo.
Поле обязательно должно быть заполнено перед вызовом GetVersionEx}
MajorVersion: DWORD; {основной номер версии ОС}
MinorVersion: DWORD; {дополнительный номер версии ОС}
BuildNumber: DWORD; {номер сборки ОС}
PlatformId: DWORD; {Идентификатор платформы}
CSDVersion: array [0..127] of char; {дополнительная текстовая
информация об установленной операционной системе}

//Далее идут поля, которые появились с выходом Windows 2000

ServicePackMajor: WORD; {основной номер service pack}
ServicePackMinor: WORD; {дополнительный номер service pack}
SuiteMask: WORD; {доступные программные пакеты; доступные
значения:
VER_SUITE_SMALLBUSINESS, VER_SUITE_ENTERPRICE,
VER_SUITE_BACKOFFICE,
VER_SUITE_COMUNICATIONS,
VER_SUITE_TERMINAL,VER_SUITE_SMALLBUSINESS_RESTRICTED,
VER_SUITE_EMBEDDEDNT,VER_SUITE_DATACENTER}
ProductType: Byte; {вариант ОС; принимает значения:
VER_NT_WORKSTATION, VER_NT_SERVER, VER_NT_DOMAIN_CONTROLLER}
Reserved: Byte; {зарезервировано для будущих версий ОС}
end;

Значения полей SuiteMask и ProductType смотри в MSDN, поскольку в
windows.pas, включая Delphi 7 описан старый вариант TOSVersionInfo (как с
этим обстоят дела в Delphi .NET).
Отсюда можно сделать вывод: или подправить windows.pas, или описывать самому
приведенную выше структуру (обрати внимание, что я специально назвал ее
TOSVersionInfoEx, чтобы не конфликтовать с TOSVersionInfo из windows.pas).
Может в jvcl поправили данную структуру.
Если ты уверен, что твой программный продукт будут использовать только на
платформах версий Windows 2000 и старше (включая Windows CE), тогда поле
CSDVersion объяви как массив WideChar и используй вызов API-функции
GetVersionExW.

Oleg Levkin <Oleg.Levkin [@] p6.f40.n5053.z2.fidonet.org>


Q-115: Как помигать Scroll Lock?
procedure TForm1.Timer1Timer(Sender: TObject);
begin
keybd_event(VK_SCROLL, 0, 0, 0);
keybd_event(VK_SCROLL, 0, vk_up, 0);
end;
++++++++++++++++++++++++++++

procedure TForm1.Timer1Timer(Sender: TObject);
begin
keybd_event(VK_SCROLL, MapVirtualKey(VK_SCROLL, 0) , 0, 0);
keybd_event(VK_SCROLL, MapVirtualKey(VK_SCROLL, 0), vk_up, 0);
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-116: Как из dll узнать узнать полный путь к этой dll.
function GetModuleFileNameStr(Instance: THandle): String;
var
buffer : array [0..MAX_PATH] of Char;
begin
GetModuleFileName( Instance, buffer, MAX_PATH);
Result := buffer;
end;

GetModuleFileNameStr(Hinstance); // dll name
GetModuleFileNameStr(0); // exe name

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-117: Как отобразить каталог?
ListBox1.Perform(LB_DIR, 0, LParam(PChar('*.*')));

Q-118: Как узнать кол-во цветов цветовой палитры?
function GetColorsCount : DWord;
var
DC : HDC;
begin
DC := GetDC( 0 );
Win32Check(DC <> 0);

Result :=1 shl (GetDeviceCaps(DC, PLANES) *
GetDeviceCaps(DC, BITSPIXEL));
ReleaseDC( 0, DC );
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-119: Как ввести текст в "чужой" Edit?
SendMessage(EditHandle, WM_SETTEXT, 0, LParam(PChar('MyText')));

Q-120: Как заставить мигать кнопку приложения на AppBar?
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Application.Handle, True);
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-121: Как сделать программу без главной формы?
program Project1;

uses
Dialogs;

begin
ShowMessage('Is there anybody out there ?' );
end.

Q-122: Как убрать VerticalScrollBar из TListBox навсегда?
procedure TListBoxForEver.CreateParams (var Params:
TCreateParams); //override
begin
inherited CreateParams(Params);
Params.Style := Params.Style and not WS_VSCROLL;
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-123: Как показать диалог выбора директории?
из модуля FileCtrl.

1. function SelectDirectory(const Caption: string; const Root: WideString;
out Directory: string): Boolean; overload;
2. function SelectDirectory(var Directory: string; Options: TSelectDirOpts;
HelpCtx: Longint): Boolean; overload;

из RxLib
TDirectoryEdit

function GetDirectory(nFolder: Longint): String;
var
Bi : TBrowseInfo;
lpName: array [0..MAX_PATH] of Char;
ppidl, aItemLst : PItemIDList;
begin
SHGetSpecialFolderLocation(Application.Handle, nFolder, ppidl);
FillChar(Bi, SizeOf(bi), 0);
Bi.hwndOwner := Application.Handle;
Bi.pidlRoot := ppidl;
Bi.pszDisplayName := lpName;
Bi.lpszTitle := 'Open directory';
aItemLst := SHBrowseForFolder(Bi);
CoTaskMemFree(ppidl);
SHGetPathFromIDList(aItemLst, lpName);
CoTaskMemFree(aItemLst);
Result := lpName;
end;

Пример использования (иначе не поймут, что такое nFolder)

// значения nFolder можно найти в описании
// к SHGetSpecialFolderLocation
// из Win32 Programmer's Reference (win32.hlp)

procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := GetDirectory(CSIDL_DRIVES);
end;

Q-124: Как убрать из ListView горизонтальный скролбар навсегда?
type
TNoHScrollListview = Class( TListview )
private
Procedure WMNCCalcSize( Var msg: TMessage ); message WM_NCCALCSIZE;
end;

procedure TNoHScrollListview.WMNCCalcSize(var msg: TMessage);
var
style: Integer;
begin
style := getWindowLong( handle, GWL_STYLE );
If (style and WS_HSCROLL) <> 0 Then

SetWindowLong( handle, GWL_STYLE, style and not WS_HSCROLL );
inherited;
end;

by Peter Below

Q-125: Кaк искать oкнo по части eгo нaзвaния?
function FindNextWnd(StartHWND: HWND; AString : String): HWND;
var
Buffer : array [0..255] of char;
begin
Result := StartHWND;
repeat
Result := FindWindowEx(0, Result, nil, nil);
GetWindowText(Result, Buffer, SizeOf(Buffer));
if StrPos(StrUpper(Buffer), PChar(UpperCase(AString))) <> nil

then Break;
until (Result = 0);
end;

Q-126: Как обнаружить активность юзера?
Application.OnMessage := DoMessageEvent;

procedure TForm1.DoMessageEvent ( var Msg: TMsg;
var Handled: Boolean);
begin
case Msg.message of
WM_KEYFIRST..WM_KEYLAST,
WM_MOUSEFIRST..WM_MOUSELAST:
{Произошли события клавиатуры и мыши};
..
end;
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-127: Как yзнать текущую Ru/En pаскладкy клавиатypы?
GetKeyboardLayoutName(buffer{:array [0..KL_NAMELENGTH] of Char});
case ((StrToInt('$'+ Buffer)) and $03FF) of
LANG_ENGLISH: Caption := 'Eng';
LANG_RUSSIAN: Caption := 'Rus';
end;
++++++++++++++++++++++++++++

procedure TForm1.Button1Click(Sender: TObject);
var
AklName: array [0..2] of Char;
begin
GetLocaleInfo( LoWord(GetKeyboardLayout(0)),
LOCALE_SABBREVLANGNAME,
AklName,
SizeOf(AklName));
Caption := AklName;
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-128: Как передать строку другому приложению?
получатель:

procedure ReceiveMessage (var Msg: TMessage); message WM_COPYDATA;
..
procedure TFormReceive.ReceiveMessage;
var
pcd : PCopyDataStruct;
begin
pcd := PCopyDataStruct(Msg.LParam);
Caption := PChar(pcd.lpData);
end;

отправитель:

procedure TFormXXX.Button1Click(Sender: TObject);
var
cd : TCopyDataStruct;
begin
cd.cbData := Length(Edit1.Text)+1;
cd.lpData := PChar(Edit1.Text);
SendMessage ( FindWindow('TFormReceive', nil),
WM_COPYDATA,
0,
LParam( [@] cd));
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-129: Как RichEdit сделать скролл на конец текста?
with RichEdit do begin
SelLength := 0;
SelStart := Length(Text);
Perform(EM_SCROLLCARET,0,0);
end;

Q-130: Удаление файлов из временного каталога, безопасно ли?
При получении имени папки предназначенной для хранения временных файлов
могут возникнуть некоторые проблемы.

>> Прекрасно это выглядит, когда в качестве каталога временных файлов

назначен например C:\Windows

> :-) Я и говорю что небезопасно.


Особенно пикантно это выглядит, в свете того, что

Remarks
Windows 95/98/Me: The GetTempPath function gets the temporary file
path as follows:

The path specified by the TMP environment variable. The path specified by
the TEMP environment variable, if TMP is not defined or if TMP specifies a
directory that does not exist. The current directory, if both TMP and TEMP
are not defined or specify nonexistent directories.

Этак переименовываешь C:\TEMP - и программа чистит текущий каталог :-)

Windows NT/2000 or later: The GetTempPath function does not verify that the
directory specified by the TMP or TEMP environment variables exists. The
function gets the temporary file path as follows:

The path specified by the TMP environment variable. The path specified by
the TEMP environment variable, if TMP is not defined. The Windows
directory, if both TMP and TEMP are not defined.

Этак удаляешь переменные окружения - и программа "деинсталлирует" Windows

Из этого вытекает следующее, удаление файлов из любого каталога, особенно из
временного чрезвычайно опасная операция, не ты создал - не трогай. Удалять
только ручками, глядя на файлы и принимая решения индивидуально по каждому
файлу.

При использовании функции GetTempPath проверить если подстрока TEMP в
результате и в случае отсутствия вхождения запросить пользователя для
принятия решения, с рекомендацией создать каталог TEMP и необходимые
переменные среды, лучше посоветоваться обратиться к администратору для
принятия решения. Это простое правило позволит избежать серьезных
последствий.

Тенцер А.Л. <tolik [@] katren.nsk.ru>

Andrew V. Fionik <fionika [@] chat.ru>

Anatoly Podgoretsky <anatoly [@] podgoretsky.com>


* Origin: Husky forever! (2:450/143.25)

ru.delphi FAQ [7-10]

Q-131: Как узнать состояние управляющих клавиш - Shift, Ctrl, Alt?
function IsKeyDown(vk: Word):Boolean;
begin
Result := GetKeyState(vk) and $8000 = $8000;
end;

vk для Ctrl, Shift, Alt соответственно равны: vk_control, vk_shift и vk_menu

Q-132: Как сохранить всю форму в файл (как Delphi в *.dfm)?
constructor TForm1.Create(AOwner: TComponent); // override;
var
fname: String;
begin
{ Для динамически создаваемых контролов, может требоваться
RegisterClasses(..); }
fname := FormFilename;
if FileExists( fname ) then
begin
CreateNew(AOwner);
ReadComponentResFile(fname, Self);
end
else
inherited Create( AOwner );
end;

procedure TForm1.FormCloseQuery( Sender: TObject;
var CanClose: Boolean);
begin
WriteComponentResFile(FormFileName, Self);
end;

{Peter Below, Vladimir Titov}

Q-133: Как контрол может сам себя разрушить?
TMyWinControl = class(TWinControl)
private
procedure WMuser1(var msg: TMessage); message WM_USER+1;
...
public
procedure Release;
...
end;

procedure TMyWinControl.WMuser1;
begin
Free;
end;

procedure TMyWinControl.Release;
begin
PostMessage(Handle, WM_USER+1, 0, 0);
end;

Q-134: Как отследить переход фокуса в приложении?
procedure TForm1.AppControlChange(Sender: TObject);
begin
if Sender is TScreen then
Caption := TScreen(Sender).ActiveForm.ActiveControl.Name;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.OnActiveControlChange := AppControlChange;
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-135: Как заставить MediaPlayer крутить один и тот же клип?
procedure TForm1.WMUser1(var msg:TMessage);// message WM_USER+1;
begin
with MediaPlayer1 do begin
Previous;
Notify := True;
Play;
end;
end;

procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
if (Sender as TMediaPlayer).NotifyValue = nvSuccessful then
PostMessage(Handle, WM_USER+1, 0, 0);
end;

Q-136: Как назначить процедуру собственному пункту системного меню?
const
cm_mycommand = $00A0;

procedure TForm1.FormCreate(Sender: TObject);
var HSysMenu: HMENU;
begin
HSysMenu:=GetSystemMenu(Handle,FALSE);
InsertMenu( HSysMenu, 0, MF_BYPOSITION or MF_STRING,
cm_mycommand, 'MyString');
end;

procedure TForm1.WMSysCommand (var Message:
TWMSysCommand); // message WM_SYSCOMMAND;
begin
case Message.CmdType of
cm_mycommand: ShowMessage('My Command');
else
inherited;
end;
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-137: Какой класс окна у консоли?
'tty' for 9x
'ConsoleWindowClass' for NT

Q-138: Какое сообщение надо отлавливать в Application.OnMessage для
отслеживания клавиши Alt (vk_menu)
WM_SYSKEYDOWN/WM_SYSKEYUP

Q-139: Как спрятать контрол, если известен его Handle?
ShowWindow(ButtonHandle, SW_HIDE); // SW_SHOW

Q-140: Как поменять иконку и стpокy в заголовке консольного окна?
procedure TForm1.Button1Click(Sender: TObject);
var
h : HWND;
AIcon : TIcon;
begin
AllocConsole;
SetConsoleTitle(PChar('Console Title'));
Sleep(0);
h := FindWindow(nil, PChar('Console Title'));
AIcon := TIcon.Create;
ImageList1.GetIcon(0, AIcon);
SendMessage(h, WM_SETICON, 1, AIcon.Handle);
AIcon.Free;
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-141: Как сделать окно без VCL?
program Project1;

{ Copyright (c) 1996 by Charlie Calvert

Standard Windows API application written in Object Pascal.
No VCL code included. This is all done on the Windows API
level.

Note that you need to include both Windows and Messages!}

uses
Windows, Messages;

const
AppName = 'Window1';

function WindowProc(Window: HWnd; AMessage, WParam,
LParam: Longint): Longint; stdcall;
begin
WindowProc := 0;

case AMessage of
wm_Destroy: begin
PostQuitMessage(0);
Exit;
end;
end;

WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;

{ Register the Window Class }
function WinRegister: Boolean;
var
WindowClass: TWndClass;
begin
WindowClass.Style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := [@] WindowProc;
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := HInstance;
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
WindowClass.hbrBackground := HBrush(Color_Window);
WindowClass.lpszMenuName := nil;
WindowClass.lpszClassName := AppName;

Result := RegisterClass(WindowClass) <> 0;

end;

{ Create the Window Class }
function WinCreate: HWnd;
var
hWindow: HWnd;
begin
hWindow := CreateWindow(AppName, 'Object Pascal Window',
ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
cw_UseDefault, cw_UseDefault, 0, 0, HInstance, nil);

if hWindow <> 0 then begin

ShowWindow(hWindow, CmdShow);
UpdateWindow(hWindow);
end;

Result := hWindow;
end;

var
AMessage: TMsg;
hWindow: HWnd;
begin
if not WinRegister then begin
MessageBox(0, 'Register failed', nil, mb_Ok);
Exit;
end;
hWindow := WinCreate;
if hWindow = 0 then begin
MessageBox(0, 'WinCreate failed', nil, mb_Ok);
Exit;
end;
while GetMessage(AMessage, 0, 0, 0) do begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;
Halt(AMessage.wParam);
end.

Q-142: Как избежать повторного запуска моего приложения?
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMCopyData(var msg: TMessage); message WM_COPYDATA;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses
checkinst;

procedure TForm1.FormCreate(Sender: TObject);
var
h : HWND;
begin
h := SetUniqueUID(Handle, 123456); // назначаем уникальный идентификатор
if h <> Handle then

begin
SendString(h, GetCommandLineStr, Handle, 0);
ActivatePrevInstance(h);
Halt;
end;
end;

procedure TForm1.WMCopyData;
begin
Memo1.Lines.CommaText := PChar(PCopyDataStruct(msg.LParam).lpData);
end;

unit checkinst;

interface

uses
Windows,
Messages,
Sysutils;

function SetUniqueUID(ahwnd: HWND; uid: DWord): HWND;
procedure ActivatePrevInstance(ahwnd: HWND);
procedure SendString(ahwnd:HWND; const s: String; aWParam: WParam;
dwData:DWord);
function GetCommandLineStr: String;

implementation

function SetUniqueUID(ahwnd: HWND; uid: DWord): HWND;
var
ClassName: array [0..255] of Char;
begin
GetClassName(ahwnd, ClassName, SizeOf(classname));
Result := FindWindowEx(0, 0, ClassName, nil);
while (Result <> 0) do

if GetProp(Result, 'UID') = uid then
Exit
else
Result := FindWindowEx(0, Result, ClassName, nil);
SetProp(ahwnd, 'UID', uid);
Result := ahwnd;
end;

procedure ActivatePrevInstance(ahwnd: HWND);
var
h : HWND;
begin
h := GetWindowLong(ahwnd, GWL_HWNDPARENT);
if IsIconic(h) then
ShowWindow(h, SW_RESTORE);
SetForegroundWindow(h);
end;

procedure SendString(ahwnd:HWND; const s: String; aWParam: WParam;
dwData:DWord);
var
cds: TCopyDataStruct;
begin
cds.cbData := Length(s)+1;
cds.lpData := Pointer(s);
cds.dwData := dwData;
SendMessage(ahwnd, WM_COPYDATA, aWParam, LParam( [@] cds));
end;

function GetCommandLineStr: String;
var
i : Integer;
begin
for i := 0 to ParamCount do
Result := Result + ' ' + AnsiQuotedStr(ParamStr(i), '"');
end;

Leonid Troyanovsky <lv.t [@] eco-pro.ru>

++++++++++++++++++++++++++++++++++++

=== Вариант с Мьютексом ===
В файле проекта (.dpr) прямо можешь написать нечто вроде:
uses windows,...
var
H: THandle;
begin
H := CreateMutex(nil, True, 'уникальное_имя_для_твоей_проги');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
H := FindWindow(nil, 'название заголовка окна программы');
SetForegroundWindow(H);
Exit;
end;
Application.Initialize;
Application.Title := 'название заголовка окна программы';
Application.CreateForm(TAppData, AppData);
Application.CreateForm(TMain, Main);
Application.Run;
CloseHandle(H);
end;

Прочко Денис Владимирович.
sysadmin [@] )farmeko.khv.ru
++++++++++++++++++++++++++++++++++++

Если быстро запустить дважды приложение, то вариант с поиском по классу окна
может не сработать, так как окно еще не успеет создаться

Анатолий Подгорецкий

Q-143: Как записать массив в файл?
with TFileStream.Create('array.dat', fmCreate or fmOpenWrite) do begin
WriteBuffer(a, SizeOf(a));
Free;
end;

Q-144: Delphi 6 требует Proxies.pas?
{$ifdef D_6_UP} // Это моя константа
DesignIntf, DesignEditors, DesignWindows, DsnConst,
{$else}
DsgnIntf,
{$endif}

Eugene Mayevski <mayevski [@] eldos.org>


Вопрос: Файл designeditors.pas использует 'proxies' в uses.
Исходный текст (proxies.pas) или откомпилированный модуль (proxies.dcu)
нигде не находится ни на моем жеском диске ни на D6 Pro CD..

Просто реорганизуйте ваш проект на использование runtime пакетов и добавьте
"DesignIDE" к вашемк списку runtime пакетов. Proxies находится здесь, и вам
не нужен исходный текст вообще.

Почему это сделано? Просто доя уверенности, что вы не сможете распространять
design time части (property editors, component editors), это запрещено по
личензии. DesignIDE.bpl не является свободно распространяемым, вы имеете
право использовать его только на машине на которой установлена Delphi,
подобно Component libraries.

forums.borland.com

Q-145: О библиотеке RxLib
Hа сайте delphiplus.org в разделе Бесплатно|RXLibrary
(delphiplus.spils.lv/RXLibrary.html) лежит RX Library 2.75 с help'ами
и четырьмя неофициальными портами RX Library 2.75 под Delphi 6:

1. Версия 1.1 (1.18M) от Oxygen Software
2. Версия 1 (1.36M) от Dennis Ortiz
3. Патч на RxLib версия 1.5 (437K) от Polaris Software
4. Версия от Epsylon Technologies

Anatoly Podgoretsky wrote:

> Hi, Delphi Plus!

> You wrote to Anatoly Podgoretsky on Tue, 20 Nov 2001 16:00:55 +0000 (UTC):


DP>> 14.11.2001 в раздел "Бесплатно|Компоненты" выложен четвертый

DP>> неофициальный порт RX Library 2.75 под Delphi 6 (от Epsylon

DP>> Technologies).


DP>> http://www.delphiplus.org - ежедневные новости информационных

DP>> технологий http://www.faq.delphiplus.org - коллекция FAQ по Delphi


> Прекрасно, этим я больше доверяю, а как вообще насчет характеристики всех

> четырех портов, а то у людей глаза разбегаются :-)


Epsylon Technologies
*************************
Здравствуйте!
Мы были вынуждены сделать свой вариант RxLib потому, что остальные нас
немного не устраивали.
Сразу скажу, зачем нам вообще нужна библиотека RxLib - она используется в
нашем продукте в качестве некоего примера всем известных компонентов.
Поэтому к такой библиотеке с нашей стороны предъявлялось требование
максимальной стандартности, если можно применить такой термин. Кроме того,
наш продукт поддерживает несколько версий Delphi и C++Builder, поэтому от
такой библиотеки требуется одновременная поддержка всех нужных нам версий
компиляторов.

Естественно, мы рассматривали варианты использования уже готовой работы по
адаптированию библиотеки под Delphi 6.0.
Однако:
- вариант от Polaris заточен для использования пакета Polaris Library.
Туда что-то добавлено, что-то починено, что-то переделано. Иначе
говоря, этот вариант не может быть стандартным;
- вариант от Oxygen является версией ТОЛЬКО под Delphi 6.0, содержит ряд
мелких неточностей при переводе design-time кода. Также там что-то
изменено по сравнению с 2.75. Кроме того, не переименован модуль
AppUtils.pas;
- вариант от Dennis Ortiz также является версией только под Delphi 6.0.
Hичего не могу сказать про нее - мы туда глубоко не заглядывали.

Hе совсем понятно, зачем выкидывать из библиотеки возможность поддержки
предыдущих версий Delphi, когда добавить вариант кода для Delphi 6.0 ничуть
не сложнее. Hикто также не против исправления каких-либо ошибок в
библиотеке, но давайте делать это централизованно, если уж авторы забили на
свое детище. Hапример, через тот же Source Forge.

Hаш вариант основан на общедоступном коде, и содержит модули из 2.75,
включая update от 16.12.1999 и патч для C+Builder 5.0 от 30.05.2000. В эти
модули добавлена возможность работы под Delphi 6.0, в том числе добавлен
макрос RX_D6 и переименованы модули AppUtils и StrUtils. Все. Hичего больше.
Hикакая старая функциональность не удалена, никакие баги не чинились. Полдня
работы.

==
Andrey Dementyev, Epsylon Technologies, www.epsylontech.com
Chief Software Architect

Информация от delphiplus
********************************
1. C 19-ого декабря компания SGB Software совместно с Hиком Ходж (Nick
Hodges) из Borland support team займется дальнейшим развитием RxLib.
Hадеются выпустить 3-ю версию к середине марта 2002 года. Все желающие могут
принять участие в этой работе, для этого достаточно написать на
RxLIb [@] SGBSoftware.com.

2. Hа DelphiPlus выложен материал "A где сейчас RXLib?" - заметка написанная
по материалам переписки в эхе fido7.ru.delphi. Hаконец эта история получила
завершение, афера SGB Software лопнула, но RXLib не погибла, а вошла в
состав более крупного проекта Jedi Code Library, за эти руки нет опасения,
все подробности на сайте delphiplus.org, благодаря которому мы были постянно
в курсе событий всех приключений с RXLib, спасибо.

* Origin: HPT is the best tosser! (2:450/143.25)

ru.delphi FAQ [8-10]

Q-146: Как хранить настройки программ.
Hижеприведенный текст являет собой вольное изложение отдельных статей
февральского выпуска Microsoft Platform SDK. Год 2001 от рождества Христова.
При проектировании способов хранения настроек своей программы следует
задаться тремя вопросами:

Что хранить.
Где хранить.
Как хранить.

Что хранить

Поскольку первая часть вопроса нам известна по определению, т.е. хранить мы
будем настройки программы, то перейдем ко второй части вопроса. Ваша
программа устанавливается на КОМПЬЮТЕР а пользуются ей ПОЛЬЗОВАТЕЛИ.
Соответственно все настройки разделяются на две части а то и на все три -
настройки которые относятся к компьютеру в целом, настройки которые
относятся ко всем локальным пользователям, настройки которые относятся к
конкретному пользовател. В зависимости от специфики программы первая и
вторая часть могут быть совмещены или разделены.
Поэтому важно сделать логическое разделение - какие настройки вашей
программы действительно специфичны для самого ПК, какие настройки должны
прилагаться ко всем пользователям, какие должны прилагаться к конкретному
пользователю. Кроме того Микрософт рекомендует чтобы настройки учитывали
возможную мобильность пользователя, т.е. для пользователя находящегося в
разных местах, возможно потребуется иметь разные наборы настроек.

Где хранить

Вообще в голову приходят три вещи.
Хранить настройки в системном реестре.
Хранить настройки в каталоге куда установлена программа.
Хранить настройки в системном каталоге Windows.
Хранить настройка в домашнем каталоге пользователя.

В Windows имеется три места предназначенных для хранения настроек которыми и
следует пользоваться.

Системный реестр
Домашний каталог пользователя (точнее один из его подкаталогов)
Общий каталог для пользователей

Прочие мысли о местах хранения настроек должны быть выброшены из голов как
вредные и противоестественные, Microsoft уже за вас все придумала и нефиг
извращаться. Для тех кто не понимает почему, объясняю. Hа нормальной ОС
(W'NT, W'2K) программа обычно запускается от имени и с правами конкретного
пользователя. Обычно, если этот пользователь не является администратором, он
имеет право изменять содержимое следующих ресурсов:

часть реестра HKEY_CURRENT_USER\*
содержимое своего домашнего каталога
содержимое временного каталога (который как правило находится внутри
домашнего)
содержимое некого каталога или каталогов специально выделенного для этого
администратором

При нормальном (читайте параноидальном) администрировании системы прочие
места либо доступны только в режиме чтения, либо вообще недоступны. В том
числе и папки \Program Files и Windows. Посему любая попытка программы
изменять любые файловые ресурсы окромя вышеуказанных черевата тем что ее
(программу) и его (пользователя) пошлют подальше. Причем далеко не в самой
вежливой форме.

Пример
Adobe Photoshop и его разработчики наивно полагают что им должны быть выданы
эксклюзивные права мусорить своими scratch-файлами в корневых каталогах
дисков, кроме того они полагают что им должна быть выдана в пользование в
режиме полный доступ часть системного реестра.. Временных каталогов,
специально выделенных для подобоного рода занятий, их не устраивает. Как
результат - Photoshop имеет серьезные проблемы с работой под Windows
NT/2000.

Системный реестр

С точки зрения хранения настроек программы системный реестр разделен на две
части. Это ветви HKEY_CURRENT_USER для хранения настроек специфичных для
пользователя, и HKEY_LOCAL_MACHINE для хранения настроек специфичных для
всего ПК и соответственно всех пользователей, работающих с этим ПК.
Рекомендуемая структура ветвей для хранения настроек программы -
HKEY_CURRENT_USER\Software\Company Name\Application Name\Version и
соответственно HKEY_LOCAL_MACHINE\Software\Company Name\Application
Name\Version. Параметры Company Name, Application Name, Version желательно
не хранить в виде hard-coded строк в коде программы а устанавливать в опциях
проекта (Project\Options\Version Info) и доставать впоследствии из ресурса с
помощью той же библиотеки RxLib. Альтернативный путь выбирать данные о
версии программы из ресурсов - использование Windows API
(GetFileVersionInfo, GetFileVersionInfoSize, VerQueryValue).
Программе следует расчитывать на то что доступ к подключам
HKEY_LOCAL_MACHINE разрешен в режиме только для чтения, а доступ к подключам
HKEY_CURRENT_USER допускает чтение, изменение и создание новых подключей и
значений.
Программе следует расчитывать на то что нужных ей ключей может не оказаться
в реестре или значения лежащие в реестре имеют неверный формат или
недопустимые значения. В таком случае, вместо несуществующих или неверных
значений настройки, программа должна использовать значения по умолчанию
которые разработчик может "железно забить в код" или получить с помощью
различных системных функций.
Hе следует использовать системный реестр для хранения больших кусков данных.
Вместо этого лучше хранить объемные данные в отдельном файле, а в реестре
запомнить имя этого файла.

Домашний каталог пользователя

Для хранения настроек слишком больших для того чтобы их размещать в реестре
существуют специально выделенные каталоги внутри домашнего каталога
пользователя. Эти каталоги обычно называются "специальными каталогами" и
имеют имена Application Data и Local Settings. Полный путь к ним можно
получить с помошью функций SHGetSpecialFolderPath или SHGetFolderPath.

Общий каталог пользователей

Обычно это каталог "Documents and Settings\All users". Внутри него имеются
такие-же подкаталоги для хранения настроек и данных программ но относящихся
ко всем пользователям. Полный путь к ним можно также получить с помошью
функций SHGetSpecialFolderPath или SHGetFolderPath.

Как хранить

Системный реестр
Для работы с системным реестром можно использовать функции Registry API
общим числом около 40 штук, а можно использовать классы из Registry.pas -
TRegistry, TRegistryIniFile, TRegIniFile. Особенно следует обратить внимание
на TRegistryIniFile который предоставляет упрощенную модель доступа к
системному реестру очень схожую с моделью работы с INI-файлами.

INI-файлы
Это старый метод хранения настроек программ, но все еще применяющийся
программистами. Hастройки хранятся в текстовом файле в виде:

[Section1]
Field1=Value1
Field2=Value2
FieldN=ValueN

[Section2]
Field1=Value1
Field2=Value2
FieldN=ValueN

[SectionN]
Field1=Value1
Field2=Value2
FieldN=ValueN

Для доступа к данным содержащимся в INI-файлах существуют классы из модуля
IniFiles - TIniFile, TMemIniFile.
Преимущество использования INI-файлов состоит в том что их можно легко
подредактировать с помощью текстового редактора. Они обычно легче
воспринимаются для прочтения нежели дерево ключей системного реестра.

Бинарные файлы настроек
Отдельно хочется поговорить о использовании бинарных файлов в качестве
хранилища для настроек программы. Обычные мотивы любителей использовать
бинарные файлы:

Экономится место
Hастройку можно спрятать от пользователя (сделать нечитабельной)

Первое глупо потому что информация о настройке занимает обычно немного места
и экономия достигается мизерная. Второе глупо потому что невозможность
просмотра и редактирования настроечных данных простыми средствами
(текстовый редактор) или встроенными (редактор реестра) создает больше
проблем как пользователю так разработчику, нежели пользы (причем весьма
сомнительной) от того что кто-то не сможет прочитать что написано в файле.
Кроме того использование бинарного файла нельзя назвать защитой от
нежелательного просмотра, т.к. любой "продвинутый пользователь" все равно с
помощью редактора бинарных файлов сможет просмотреть и разобраться в
содержимом настройки.

Заключение

Почти вся эта информация была вычерпана из кладезя мудрости под названием
Platform SDK (Software Development Kit), поставляемого в составе сборника
документации MSDN (Microsoft Software Developer Network). Разработчикам
настоятельно рекомендуется приобрести Platform SDK, это снимает огромную
массу вопросов связанную с программированием под Windows.

Q-147: Как вывести ProgresBar на StatusBar?
- --- Андрей Барташ

Gauge:=TGauge.Create(Form1);
Gauge.Parent:= StatusBar1;
Gauge.Top:=4;
Gauge.Left := 116;
Gauge.Height := 15;
Gauge.Width := 200;

Компонент TGauge находится на закладке Samples

I-148: Список рекомендуемой литературы
1. А. Архангельский, В. Ильин, М. Тагин
Русская справка (HELP) по Delphi 5 и Object Pascal (32 стр. с CD-ROM)
Бином, ISBN 5-7989-0168-8

2. А. Архангельский. Программирование в Delphi 5
Бином, ISBN 5-7989-0104-1

3. А. Архангельский. Программирование в Delphi 6
Бином, ISBN 5-7989-0227-7

4. П. Даpахвелидзе, Е. Маpков
Delphi 4 в подлиннике

5. П. Дарахвелидзе, Е. Марков, О. Котенок
Программирование в Delphi 5
BHV-СПб, ISBN 5-8206-0052-5

6) П.В. Шумаков, В.В. Фаронов "Delphi xx. Руководство разработчика баз
данных."

7) М.Кэнту
Delphi 4 для пpофессионалов

8. Ч.Калвеpт
Delphi 4, Энциклопедия пользователя

9. Стив Тейксейра, Ксавье Пачеко
Delphi 5. Руководство разработчика. Том 1.
Основные методы и технологии программирования
Вильямс, ISBN 5-8459-0016-6
2000 Вильямс

10. Стив Тейксейра И Ксавье Пачеко
Delphi 5. Руководство разработчика. Том 2.
Разработка компонентов и работа с базами данных
2000 Вильямс
ISBN 5-8459-0066-2

11. Конопка Рей
Создание оригинальных компонент в среде Delphi: Пер. с англ./Рей Конопка.
К.: HИПФ - "ДиаСофт Лтд.", 1996. - 512 с.
ISBN 5-7707-9551-4

12. Лишнер Рэй
Секреты Delphi 2: Пер. с англ./Рэй Лишнер. -
К.: HИПФ - "ДиаСофт Лтд.", 1996. - 800 с.
ISBN 966-7033-10-4

13. Том Сван "Секреты 32-разрядного программирования в Delphi"
Диалектика, Киев, 1997. 480 стр.,
ISBN 966-506-052-X (рус.)

14. Дэн Оузьер "Дельфи 2. Освой самостоятельно."
Восточная Книжная Компания,
1997. 624 стр. Binom.

15. Михаил Кpаснов. DirectX Гpафика в пpоектах Delphi
BHV
ISBN-5-94157-033-3

В списке отсутствует ряд хороших книг, по причине недостаточнысти данных,
если у кого есть замечания, исправления или дополнения по данной статье, то
просьба посылать их прямо на mailto: anatoly [@] podgoresky.com

Hовые книги можно искать и заказывать через Интернет на сайте
books.ru
Там же как правило есть аннотация.

Кроме указанных книг существует большое количество ресурсов в Интернете
посвященных Дельфи - это статьи, электронные библиотеки и прочее. Один из
ресурсов расположен на моем сайте - это несколько проектов электронных
библиотека, в совокупности свыше 200 книг. Доступ ко всем проектам прямо с
главной страницы www.podgoretsky.com, существует так же доступ и по
FTP (3 анонимных сессии)

Один из недостатков, это то что сервер сильно перегружен все 24 часа в
сутки, семь дней в неделю, поэтому скорость весьма низкая, поэтому
желательно использовать какой либо менеджер закачек, также не рекомендуется
использовать многопотоковую закачку, это не ускорит сам процесс закачки, а
только уменьшит возможность закачки для других пользователей.
Большинство книг с моего сервера, также доступны и на других серверах и если
есть возможность взять их из другого источника, то это будет более
оптимальным вариантом по скорости.

Q-149: Как нажать клавиши в другом приложении?
"Hажимаем" клавиши в Блокноте (уже запущенном):

uses Sendkey; {описан ниже}

procedure TForm1.Button1Click(Sender: TObject);
var
h: HWND;
begin
h := FindWindow('Notepad', nil); // ищем окно Блокнота
SendMessage(h, WM_SYSCOMMAND, SC_HOTKEY, h); // активизируем его
PlayKeys(StrToKeys('abcdef')); // нажимаем клавиши
SendMessage(Handle, WM_SYSCOMMAND, SC_HOTKEY, Handle); // возвращаем фокус
end;

Коды vk_ клавиш можно найти в Win32 Programmer's Reference (win32.hlp):
Virtual-Key Codes. {В дельфи не описаны коды клавиш ['A'..'Z'] и ['0'..'9'],
их получают с помощью Ord, например, Ord('A'), Ord('9')}.

Символы из верхнего ряда клавиатуры посылаются с нажатым Shift. Заметим, что
символы в локальной кодировке могут быть посланы после переключения
кодировки в активном приложении, например, если перключатель (switch)
Control-Shift, то это:

PlayKeys(Chr(vk_control)+#0+Chr(vk_shift)+#0); {downkey = #0};

- --- unit Sndkey.pas ---

unit sndkey;

interface

uses
Windows,
Messages;

const
{VK constants missing from windows.pas}
VK_SEMICOLON = 186; {;}
VK_EQUAL = 187; {=}
VK_COMMA = 188; {,}
VK_MINUS = 189; {-}
VK_PERIOD = 190; {.}
VK_SLASH = 191; {/}
VK_BACKQUOTE = 192; {`}
VK_LEFTBRACKET = 219; {[}
VK_BACKSLASH = 220; {\}
VK_RIGHTBRACKET = 221; {]}
VK_QUOTE = 222; {'}

downkey = #0;
upkey = Chr(KEYEVENTF_KEYUP); {#2}

procedure PlayKeys(const keys: String);
function StrToKeys(const s: String): String;

{Alt-F4:
PlayKeys(Chr(vk_menu)+#0+Chr(vk_f4)+#0+Chr(vk_f4)+#2+Chr(vk_menu)+#2)}
{"exit"<return>: PlayKeys(StrToKeys('exit'+chr(vk_return)));}

{"EXIT":
PlayKeys(Chr(vk_shift)+downkey+StrToKeys('exit')+Chr(vk_shift)+upkey));}
{or short form: PlayKeys(Chr(vk_shift)+#0+StrToKeys('exit'));}

implementation

function StrToKeys; {keystroke for alone keys}
var
i: Longint;
c: Char;
begin
for i := 1 to Length(s) do
begin
c := s[i];
if c in ['a'..'z'] then {Upper}
c := Chr(Ord(c) and not $20);
Result := Result + c + downkey
+ c + upkey;
end;
end;

procedure PlayKeys;
const
ExtendedKeys : set of byte =
[ vk_up, vk_down,
vk_left, vk_right,
vk_home, vk_end,
vk_prior, vk_next,
vk_insert, vk_delete];
var
i, ips : Longint;
fb, sb: Byte;
keysdown: String;

procedure keybd (vk, kp : Byte);
begin
if vk in ExtendedKeys then
kp := kp + KEYEVENTF_EXTENDEDKEY;
keybd_event(vk, MapVirtualKey(vk, 0), kp, 0);
end;

begin
keysdown := '';
for i := 1 to Length(keys) div 2 do
begin
fb:= Ord(keys[2*i -1]);
sb:= Ord(keys[2*i]);
if sb = Ord(downkey) then
keysdown := keysdown + Chr(fb)
else
begin
ips := pos(Chr(fb), keysdown);
if ips > 0 then

Delete(keysdown, ips, 1)
else
Continue;
end;
keybd(fb, sb);
end;
{Autocomplete}
for i := 1 to Length(keysdown) do
keybd(Ord(keysdown[i]), Ord(upkey));
end;

end.
- --- EOF unit Sndkey.pas ---

Leonid Troyanovsky <lv.t [@] eco-pro.ru>


Q-150: Как перетащить файлы из проводника в мою программу
TMainForm = class(TForm)
...
private
procedure WMDROPFILES(var Message: TWMDROPFILES); message
WM_DROPFILES;
procedure ProcessFile(Filename: string);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
DragAcceptFiles(MainForm.Handle, TRUE); // enable drag&drop
end;

procedure TMainForm.ProcessFile(Filename: string);
begin
// any actions
end;

procedure TMainForm.WMDROPFILES(var Message: TWMDROPFILES);
var
Files : Longint;
I : Longint;
Buffer : array[0..MAX_PATH] of Char;
begin
Files := DragQueryFile(Message.Drop,$FFFFFFFF,nil,0); // Get count of
files
for I := 0 to Files - 1 do begin
DragQueryFile(Message.Drop,I, [@] Buffer,SizeOf(Buffer)); // Get N file
ProcessFile(Buffer); // do something with the file
end;
DragFinish(Message.Drop); // end drag loop
end;

"Anatoly Podgoretsky" <anatoly [@] podgoretsky.com>


* Origin: Formatting C: ... (2:450/143.25)

ru.delphi FAQ [9-10]

Q-151: Как использовать в Дельфи API фyнкции
AA> как это ни странно, вызывать их. предварительно заюзав модуль windows.


Правильнее : вызвать, предварительно подключив модуль, в котором данная
функция описана (это может быть windows, activex, shellapi и т.д.).
Hайти модуль поможет клавиша F1 на имени функции.

Если функция не нашлась - то попробовать сделать поиск в папке с исходными
текстами Дельфи.

Если функция не нашлась - есть шанс, что в этой версии Дельфи она не
описана. В этом случае надо поискать "заголовочный файл" (API header file) в
интернете. Огромная коллекция их находится на сайте www.delphi-jedi.org.

Если не помогло и это - придется взять описание функции из документации
производителя данного API (обычно оно на С) и самому сделать ее обьявление,
так же, как это сделано в windows.pas, только в своем юните.

Сергей Кабиков

Q-152: Автоматическое определение кодировки текста
AG> Существуют ли в сободном для изучения доступе алгоритмы автоматического

AG> определения кодировки текста?

О, еще сколько. Методом таблицы модельных распределений:

type
TCodePage = (cpWin1251, cp866, cpKOI8R);
PMap = ^TMap;
TMap = array [#$80..#$FF] of Char;

function GetMap(CP: TCodePage): PMap;
{ должна возвращать указатель на таблицу перекодировки из CP в Windows1251
(nil для CP = cpWin1251) }
begin
GetMap:=nil;
end;

function DetermineRussian(Buf: PChar; Count: Integer): TCodePage;
const
ModelBigrams: array [0..33, 0..33] of Byte = (
{АБВГДЕЖЗИЙКЛМHОПРСТУФХЦЧШЩЪЫЬЭЮЯ_Ё}
{А}(0,20,44,12,22,23,16,60,4,9,63,93,47,110,0,16,35,61,81,1,5,13,24,17,12,4,
0,0,0,0,14,31,205,1),
{Б}(19,0,0,0,4,19,0,0,8,0,2,15,1,4,41,0,15,5,0,15,0,2,1,0,0,6,16,37,0,0,0,4,
3,0),
{В}(97,0,1,0,2,57,0,5,40,0,4,25,2,23,78,2,8,28,4,12,0,1,0,0,8,1,0,40,1,0,0,5
,106,3),
{Г}(13,0,0,0,9,5,0,0,15,0,1,17,1,2,96,0,24,0,0,7,0,0,0,0,0,0,0,0,0,0,0,0,8,0
),
{Д}(63,0,9,1,2,71,1,0,35,0,3,16,2,22,50,2,19,9,2,25,0,2,1,0,1,0,1,9,4,0,1,5,
17,4),
{Е}(4,14,15,34,56,22,13,14,2,34,39,77,73,150,6,9,101,64,81,1,0,15,5,12,10,6,
0,0,0,0,3,4,235,1),
{Ж}(13,0,0,0,12,47,0,0,16,0,1,0,0,23,0,0,0,0,0,3,0,0,0,0,0,0,0,0,0,0,0,0,2,2
),
{З}(76,2,11,3,11,4,1,0,7,0,2,4,11,24,17,0,6,1,0,8,0,0,0,0,0,0,0,16,6,0,1,4,1
7,0),
{И}(7,9,32,5,18,60,4,42,31,27,28,46,55,49,12,7,26,60,53,0,5,25,14,28,4,1,0,0
,0,0,9,56,255,0),
{Й}(0,0,0,0,2,0,0,0,0,0,1,3,0,3,0,0,0,10,3,0,0,0,0,1,1,0,0,0,0,0,0,0,122,0),
{К}(92,0,3,0,0,7,2,1,39,0,0,27,0,14,110,0,18,5,35,18,0,0,11,0,0,0,0,0,0,0,0,
0,5,5,0),
{Л}(85,1,0,2,1,70,6,0,85,0,5,3,0,9,67,1,0,9,0,15,0,0,0,2,0,0,0,9,66,0,15,43,
57,4),
{М}(44,0,0,0,0,65,0,0,47,0,1,1,10,15,57,7,0,2,0,24,0,0,0,0,0,0,0,28,0,0,0,8,
109,3),
{}(139,0,0,1,11,108,0,4,152,0,7,0,1,69,161,0,0,8,25,24,5,1,5,2,0,1,0,83,10,0
,1,29,38,5),
{О}(0,72,139,76,74,32,32,19,12,52,21,93,68,72,7,34,93,102,98,1,2,6,6,19,15,2
,0,0,0,1,4,9,252,2),
{П}(17,0,0,0,0,43,0,0,14,0,1,9,0,1,125,3,120,1,2,8,0,0,0,0,0,0,0,3,6,0,0,3,2
,2),
{Р}(151,1,6,4,3,103,7,0,76,0,4,0,11,10,117,1,0,5,9,39,2,5,0,1,3,0,0,24,7,0,1
,10,22,5),
{С}(24,1,21,0,3,39,0,0,33,0,56,41,11,15,58,30,5,30,183,16,0,4,1,4,1,0,0,8,25
,0,1,50,41,2),
{Т}(83,0,43,0,3,87,0,0,71,0,9,3,2,26,180,0,55,33,1,23,1,0,1,4,0,0,0,20,78,0,
0,5,82,4),
{У}(3,6,7,14,19,8,13,6,0,1,13,15,10,7,0,12,17,16,19,0,1,3,0,12,5,8,0,0,0,0,2
2,1,65,0),
{Ф}(4,0,0,0,0,4,0,0,11,0,0,1,0,0,9,0,3,0,0,4,1,0,0,0,0,0,0,0,0,0,0,0,2,0),
{Х}(9,0,2,0,0,2,0,0,5,0,0,1,0,5,26,0,4,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,76,0),
{Ц}(5,0,0,0,0,16,0,0,48,0,1,0,0,0,4,0,0,0,0,3,0,0,0,0,0,0,0,2,0,0,0,0,3,0),
{Ч}(30,0,0,0,0,52,0,0,23,0,3,1,0,14,1,0,0,0,36,5,0,0,0,0,1,0,0,0,1,0,0,0,2,2
),
{Ш}(13,0,0,0,0,28,0,0,17,0,4,4,0,4,3,0,0,0,1,3,0,0,0,0,0,0,0,0,3,0,0,0,1,1),
{Щ}(6,0,0,0,0,23,0,0,16,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,1),
{Ъ}(0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0),
{Ы}(0,5,14,1,3,28,0,2,0,22,6,19,21,2,0,5,4,7,10,0,0,37,0,3,4,0,0,0,0,0,0,1,8
4,0),
{Ь}(0,1,0,0,0,9,0,10,1,0,13,0,2,26,0,0,0,10,3,0,0,0,1,0,6,0,0,0,0,0,6,4,117,
0),
{Э}(0,0,0,0,0,0,0,0,0,0,3,3,0,0,0,0,0,0,31,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0),
{Ю}(0,5,0,0,3,0,0,0,0,0,0,1,0,0,0,0,0,1,15,0,0,0,1,4,1,15,0,0,0,0,0,0,38,0),
{Я}(0,0,9,2,7,10,3,19,0,0,1,6,7,8,0,0,2,6,19,0,0,3,5,1,0,3,0,0,0,0,5,2,177,0
),
{_}(42,80,193,43,109,41,18,53,159,0,144,27,83,176,187,229,70,231,99,47,15,13
,6,58,7,0,0,0,0,38,0,22,0,2),
{Ё}(0,0,0,0,3,0,0,0,0,0,2,4,4,8,0,0,5,3,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0));
{ "рейтинг" буквы Ё условно принимается равным 1/20 от "рейтинга" буквы E,
если сочетание с участием Ё корректно, иначе - 0 }
type
TVariation = array [0..33, 0..33] of Integer;
var
I, J, iC, iPredC, Max: Integer;
C: Char;
CP: TCodePage;
D, MinD, Factor: Double;
AMap: PMap;
PV: ^TVariation;
Vars: array [TCodePage] of TVariation;
begin
DetermineRussian:=cpWin1251; { по yмолчанию }
{ вычисление распределений биграмм }
FillChar(Vars, SizeOf(Vars), 0);
for CP:=Low(Vars) to High(Vars) do begin
AMap:=GetMap(CP);
PV:= [@] Vars[CP];
iPredC:=32;
for I:=0 to Count - 1 do begin
C:=Buf[I];
iC:=32;
if C >= #128 then begin

if AMap <> nil then C:=AMap^[C];

if not (C in ['Ё', 'ё']) then begin
C:=Chr(Ord(C) and not 32); { 'a'..'я' -> 'А'..'Я' }

if C in ['А'..'Я'] then iC:=Ord(C) - Ord('А');
end
else
iC:=33;
end;
Inc(PV^[iPredC, iC]);
iPredC:=iC;
end;
end;
{ вычисление метрики и определение наиболее правдоподобной кодировки }
MinD:=0;
for CP:=Low(Vars) to High(Vars) do begin
PV:= [@] Vars[CP];
PV^[32, 32]:=0;
Max:=1;
for I:=0 to 33 do
for J:=0 to 33 do
if PV^[I, J] > Max then Max:=PV^[I, J];

Factor:=255 / Max; { ноpмализация }
D:=0;
for I:=0 to 33 do
for J:=0 to 33 do
D:=D + Abs(PV^[I, J] * Factor - ModelBigrams[I, J]);
if (MinD = 0) or (D < MinD) then begin
MinD:=D;
DetermineRussian:=CP;
end;
end;
end;

begin
{ тест: слово 'Пример' в разных кодировках (веpоятность ошибок на таких
коpотких текстах высока - в данном слyчае пpосто повезло!) }
writeln(DetermineRussian(#$CF#$F0#$E8#$EC#$E5#$F0, 6) = cpWin1251);
writeln(DetermineRussian(#$8F#$E0#$A8#$AC#$A5#$E0, 6) = cp866);
writeln(DetermineRussian(#$F0#$D2#$C9#$CD#$C5#$D2, 6) = cpKOI8R);
readln;
end.

--
Best regards,
Stas Malinovski. mailto:stasm [@] tsl.ru

Q-153: Как помигать лампочками на клавиатуре?
var
KeyState : TKeyboardState;
begin
GetKeyboardState(KeyState);
KeyState[VK_NUMLOCK] := KeyState[VK_NUMLOCK] xor 1;
SetKeyboardState(KeyState);
end;

Изменяет состояние индикаторов на обратное...
См. также VK_NUMLOCK, VK_CAPITAL

WinNT:
{
keybd_event( VK_SCROLL, 0x46, KEYEVENTF_EXTENDEDKEY | 0, 0 );
keybd_event( VK_SCROLL, 0x46, KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP,
0);
}

Stas Malinovski. mailto:stasm [@] tsl.ru

Q-154: Как создать в runtime форму
with TxxForm.Create(Self) do Show;

with TxxForm.Create(Self) do
try
ShowModal;
finally
Free;
end;

Q-155: Как прочитать порт или записать в него.
В мультизадачных ОС как правило доступ к портам запрещен идеологией системы.
И это неспроста - подумайте, что будет, если одновременно с вашей программой
этот же порт попробует использовать другая программа.

Hо в Win9x существует частичная возможность обратиться напрямую с помощью
ассемблерных команд. Делать это надо с определенной осторожность. Даже если
вы получите доступ до порта на своей машине, то это не означает, что это
будет и на другой машине, например доступ до LPT порта может быть закрыт
драйвером принтера, такое редко но встречается. Доступ к наиболее важным
портам прикрыты запрещен полностью соответствующими системными драйверами.

В Win NT доступ к оборудованию со стороны пользовательской программы
запрещен полностью. Для доступа на этих ОС требуется использовать kernel
mode драйвера, тоже самое рекомендуется и для Win9x.
Вот несколько полезных ссылок:

TVicHW32 www.entechtaiwan.com/tools.htm
Tinyport (NT)
www.winsite.com/info/pc/winnt/programr/tinypo21.zip.drag
DriverX www.tetradyne.com
giveio (NT)
www.wideman-one.com/gw/tech/Delphi/iopm/index.htm
Ports, by Harold Howe, www.bcbdev.com/components.htm

Код доступа к портам с помощью ассемблера.

procedure WritePortByte(Port:Word; Value:Byte);
asm
XCHG EDX,EAX
OUT DX,AL
end;

procedure WritePortWord(Port:Word; Value:Word);
asm
XCHG EDX,EAX
OUT DX,AX
end;

function ReadPortByte(Port:Word) : Byte;
asm
MOV EDX,EAX
IN AL,DX
end;

function ReadPortWord(Port:Word) : Word;
asm
MOV EDX,EAX
IN AX,DX
end;

Примечание:

Существуют устройства с подряд идущими (по адресам) _байтовыми_ портами, к
которым нельзя обращаться со словными командами I/O. Hа сегодня они почти
вымерли, но :

При выборе типа процедуры (BYTE или WORD) следует ориентироваться на
спецификацию устройства ввода-вывода, к которому идет
обращение. Hе следует обращаться к байтовому устройству с
WORD-ориентированными процедурами - экономия времени мизерная, а побочные
эффекты могут быть катастрофическими."
Hапример, некоторые адаптеры сбрасывают биты ошибок после чтения
статус-регистра. Другие отображают несколько внутренних регистров на один
адрес I/O, и т.п.

Hа некоторых старых компьютерах Word процедуры могут не работать из за
специфических особенностей интерфейса, правда такие компьютера практически
уже не встречаются. Есть ISA Bus Specification, где эти вопросы четко
формализованы. Выборка словного порта может быть разбита на два раза, даже
если адрес четный, в зависимости от пожеланий устройства I/O.

Q-156: Как работать с битами?
Есть два способа.
Hизкоуровневый подход обеспечивается логическими операциями :

var
I : integer;
N : integer; // Hомер бита в диапазоне от
0..SizeOf(TYPE)*8 - 1

I := I or (1 shl N); // установка бита
I := I and not (1 shl N); // сброс бита
I := I xor (1 shl N); // инверсия бита
if (i and (1 shl N)) <> 0 then... // проверка установленного бита


Высокоуровневый подход опирается на представление числа в виде множества:

type
TIntegerSet = set of 0..SizeOf(Integer)*8 - 1;
var
I : Integer;
N : Integer;

Include(TIntegerSet(I), N); // установили N-ный бит в 1
Exclude(TIntegerSet(I), N); // сбросили N-ный бит в 0
if N in TIntegerSet(I) then... // проверили N-ный бит

Q-157: Как удалить непустой каталог?
procedure TForm1.Button1Click(Sender: TObject);
var
lpFileOp: TSHFileOpStruct;
begin
FillChar(lpFileOp,SizeOf(lpFileOp),0);
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_DELETE;
lpFileOp.pFrom := PChar(Edit1.Text);
lpFileOp.fFlags := FOF_NOCONFIRMATION;
SHFileOperation(lpFileOp);
end;

Ivan Daniloff <<abc12345 [@] eprst.ru>>


Q-158: Как получить список файлов со всеми подкаталогами
procedure ScanDir(StartDir: string; Mask:string; List:TStrings);
var
SearchRec : TSearchRec;
begin
if Mask = '' then Mask := '*.*';
if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';

if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
begin
repeat
Application.ProcessMessages;
if (SearchRec.Attr and faDirectory) <> faDirectory then

List.Add(StartDir + SearchRec.Name)
else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then

begin
List.Add(StartDir + SearchRec.Name + '\');
ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
end;
until FindNext(SearchRec) <> 0;

FindClose(SearchRec);
end;
end;

Пример вызова. параметры
1. имя папки
2. маска, по умолчанию *.*
3. хранилище для резульатат, любой наследник от TString, например
TStringList

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Clear;
ScanDir('c:','',ListBox1.Items);
Label1.Caption := IntToStr(ListBox1.Items.Count);
end;

Анатолий Подгорецкий
anatoly [@] podgoretsky.com

В связи с тем, что многие не понимают работу с масками, например пытаются
искать файлы *.txt во всех подкаталогах, вот модифицированная версия для
поиска файлов, которая для поиска подкаталогов использует мвску *.*, а для
файлов указанную маску.
Процедура представлена Юрием Зотовым.

procedure FindAllFiles(List: TStrings; Dir, Mask: string);

procedure ScanDir(Dir: string);
var
SR: TSearchRec;
begin
Dir := IncludeTrailingBackSlash(Dir);
if FindFirst(Dir + '*.*', faAnyFile - faVolumeID, SR) = 0 then
try
repeat
if (SR.Name <> '.') and (SR.Name <> '..') then

if SR.Attr and faDirectory <> 0 then

ScanDir(Dir + SR.Name)
else
if MatchesMask(SR.Name, Mask) then
List.Add(Dir + SR.Name)
until FindNext(SR) <> 0

finally
FindClose(SR)
end
end;

begin
if (List = nil) or not DirectoryExists(Dir) or (Mask = '') then
raise Exception.Create('Invalid parameter');
List.Clear;
ScanDir(Dir)
end;

Примечания: функция MatchesMask существует только с определенных версий
Дельфи, как минимум в 5 есть.

Q-159: Как преобразовать unix time в TDateTime
unix timestamp представляет собой число секунд начиная с 1.01.1970

const
SecPerDay = 86400;
Offset1970 = 25569;

function UnixTimeToDateTime(UnixTime : LongInt): TDate;
begin
Result := UnixTime / SecPerDay + Offset1970;
end;

function DateTimeToUnixTime(DelphiDate : TDate) : LongInt;
begin
Result := Trunc((DelphiDate - Offset1970) * SecPerDay);
end;

Если необходима корректировка зимнего/летнего времени, то ее следует сделать
самостоятельно.

Q-160: Как сделать .manifest для Windows XP
Для того, чтобы программы запускаемые под Windows XP, имели новый вид,
необходимо вместе с программой поставить файл *.manifest или включить его в
ресурс.
Для это изготовить файл, по ниже приведенной инструкции, назвать его
Project1.exe.manifest, по положить рядышком с Project1.exe, после это
запускаешь под XP и радуешься :-)

<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="Igor.Schevchenko.XPUtilsTest" type="win32">
<description>XP User utils test</description>
<dependency>
<dependentAssembly>
<assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="X86" publicKeyToken="6595b64144ccf1df" language="*" />
</dependentAssembly>
</dependency>
</assembly>

Строчку name="Igor.Schevchenko.XPUtilsTest" меняешь на
name="Kostya.Ergin.Project1"

С уважением,
Игорь Шевченко
++++++++++++++++++++++++++++++

В Delphi Studio 7 Enterprise и Professional, приложения Borland VCL теперь
включают компоненты, которые разрешают поддержку WindowsR общих контролов
версии 6. Ваше приложение автоматически использует новые контролы Windows на
системе Windows XP, если найдет подходящий манифест файл. Более подробно об
этом в руководстве Developer's Guide тема "Common controls and XP themes"
или в справочной системе.

Анатолий Подгорецкий

* Origin: Formatting C: ... (2:450/143.25)

ru.delphi FAQ [10-10]

Q-161: Как узнать версию программы
function GetFileVersion(const FileName: TFileName; var Major, Minor,
Release, Build: Integer): Boolean;
var
InfoSize, Wnd: DWORD;
VerBuf: Pointer;
FI: PVSFixedFileInfo;
VerSize: DWORD;
begin
Result:= False;
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 begin
Major:= FI.dwFileVersionMS shr 16;
Minor:= FI.dwFileVersionMS and $FFFF;
Release:= FI.dwFileVersionLS shr 16;
Build:= FI.dwFileVersionLS and $FFFF;
Result:= True;
end;
finally
FreeMem(VerBuf);
end;
end;
end;

Ilya Katargin <Ilya.Katargin [@] f9.n5029.z2.fidonet.org>


function GetFileVersion(FName: TFileName): String;
var
S: String;
n, Len: Cardinal;
Buf, Value: PChar;
begin
Result:='';
S := FName;
n := GetFileVersionInfoSize(PChar(S), n);
if n = 0 then Exit;
Buf := AllocMem(n);
GetFileVersionInfo(PChar(S), 0, n, Buf);
if VerQueryValue(Buf, PChar('StringFileInfo\041904E3\FileVersion'),
Pointer(Value), Len) then
Result:=Value;
FreeMem(Buf, n);
end;

шеп <шеп [@] p256.f1355.n5020.z2.fidonet.org>


> if VerQueryValue(Buf, PChar('StringFileInfo\041904E3\FileVersion'),


Здесь жестко прописан язык и кодовая страница '041904E3'.
В хелпе к Д6 тоже прописано жестко: '040904E4' (см. Reading version
information в хелпе). Я ,кстати, сам не сразу сообразил, что это значение
в хелпе не работает для русского языка :(
А ведь это значение можно взять там же:
type
TLangChrSet = array[0..1] of word;
PLangChrset = ^TLangChrSet;
var
LangChrSet: PLangChrSet;
после получения FileVersionInfo
VerQueryValue(Buf, PChar('VarFileInfo\Translation'),
pointer(LangChrset), Len);
S:=Format('%.4x%.4x',[LangChrSet^[0], LangChrSet^[1]]);
теперь в S у нас то, что надо :)

С Уважением, Евгений Переверзев.
Eugene [@] asv.afn.ru

Q-162: Как выключить или презагрузить компьютер
procedure Shutdown(Flags: DWORD);
var
hToken: THandle;
Luid: Int64;
NewPrivileges: TTokenPrivileges;
OldPrivileges: TTokenPrivileges;
OldPrivilegesSize: DWORD;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT
then // получения привилегий для платформы NT
begin
// получения локального уникального ИД
Win32Check(LookupPrivilegeValue(nil, 'SeShutdownPrivilege', Luid));
// получения токена процесса
Win32Check(OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
NewPrivileges.PrivilegeCount := 1;
NewPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
NewPrivileges.Privileges[0].Luid := Luid;
// настройка привилегий
AdjustTokenPrivileges(hToken,
False,
NewPrivileges,
SizeOf(OldPrivileges),
OldPrivileges,
OldPrivilegesSize);
try
Win32Check(GetLastError = ERROR_SUCCESS);
finally
CloseHandle(hToken);
end
end;
Win32Check(ExitWindowsEx(Flags, 0));
end;

Вызов: Shutdown(EWX_SHUTDOWN or EWX_POWEROFF);

Флаги можно комбинировать c помощью оператора OR
EWX_FORCE - принудительное выполнение операций, без сохранения данных.4
EWX_LOGOFF - выход из сеанса текущего пользователя;
EWX_POWEROFF - выключение питания;
EWX_REBOOT - пеpезагpузка Windows;
EWX_SHUTDOWN - выключение Windows, точка в которой безопасно выключать
питание.

В разработке темы приняли многие участники конференции, особая благодарность
Andrey Gusev <Andrey.Gusev [@] p11.f121.n5050.z2.fidonet.org> и Leonid

Troyanovsky <lv.t [@] eco-pro.ru>

===

Также можно использовать функцию InitiateSystemShutdown. С помощью данной
ф-и можно выключать/перезагружать и удаленные компьютеры в локальной сети.
Только в этом случае дополнительно необходимо иметь привилегию
SeRemoteShutdownPrivilege.
Бакланов Денис <dbacklanov [@] incon.ru>


Q-163: Куда пропали те или другие компоненты в Д7
Последнее время часто задаются вопросы, куда девались те или другие
компоненты в Д7. Большинство из них некуда не девалось, а просто не
инсталлировано. Для инсталляции надо найти соответсвующий bpl файл в папке
BIN и проинсталлировать. По ряду компонент надо поискать readme, которые
могут находиться в других папках, например в DEMOS/

P.S. Если ктото приведет список bpl файлов, то статья будет дополнена данной
информацией.

Client/ServerSocket - delphi7\bin\dclsockets70.bpl
Quick Report - delphi7\bin\dclqrt70.bpl
TeeChart = delphi7\Bin\dcltqr70.bpl

Анатолий Подгорецкий
podgoretsky.com

Q-164: Время работы Windows
//Возврат времени работы Windoes
// в формате TDateTime
function WindowsUptimeDays: TDateTime;
var
lpPerformanceCount: Int64;
lpFrequency: Int64;
begin
if QueryPerformanceCounter(lpPerformanceCount) then
begin
QueryPerformanceFrequency(lpFrequency);
// в отличие от GetTickCount будет работать более 49 суток
Result := lpPerformanceCount / lpFrequency / SecsPerDay;
end
else
// на случай, если нет мультимедийного таймера
Resul t:= GetTickCount/MSecsPerDay;
end;

//Возврат времени работы Windoes
//в формате d, hh:mm:ss
function WindowsUptimeStr: string;
var
DT: TDateTime;
begin
DT := WindowsUptimeDays:
Result := (Trunc(DT)) + ', ' + TimeToStr(DT);
end;

Вызов
S := WindowsUptimeToStr(WindowsUptime):

"Слава Сысолятин" <slava [@] magicbitsoft.com>


* Origin: Programming in progress... (2:450/143.25)

ru.delphi FAQ Оглавление

==================
Start Of Content
Date: 12.06.2004
==================
I-1 Версия от 12.06.2004
I-2 Введение
I-3 Авторские права
I-4 Преамбула
I-5 О поле Subject:
I-6 Здесь не приветствуется
I-7 Доступность этого FAQ
I-8 Информация о программе
I-9 Источники информации
Q-10 Каким именно релизом Delphi вообще стоит пользоваться для каждой
конкретной версии?
Q-11 Как исправить проблемы с вызовом помощи при одновременно стоящих
Delphi 1 и Delphi 2
Q-12 Delphi 2 и 3 не отображают русские TTF под Windows NT WorkStation
+ ServicePack#3
Q-13 Как включить окошко CPU Window?
Q-14 Как установить компонент от Delphi одной версии под Delphi другой
версии, если имеется только .DCU
Q-15 Delphi 4 виснут при запуске. Видеокарта S3 Virge.
Q-16 Как вывести диалог выбора каталога?
Q-17 При работе программ на D1 под Win95 на иконках TBitBtn'ов
обнаруживаются странные артефакты
Q-18 Можно ли скомпилировать на Delphi 2/3/4 программу, работающую под
Windows 3.1?
Q-19 Куда из Delphi 3 делся модуль для работы с ReportSmith? А мои
любимые модули работы с OLE
Q-20 Как сделать так, чтобы при щелчке по кнопке или по TLabel
запускался браузер
Q-21 Hе работает передача данных по OLE в русский Excel.
Q-22 Как русифицировать сообщения программы?
Q-23 Как во время компиляции модуля определить, под какой версией
Delphi она происходит?
Q-24 Как сделать так, чтобы при щелчке по кнопке или по TLabel
отправить письмо
Q-25 Как сделать так, чтобы программу можно было запустить только в
одном экземпляре?
Q-26 Как мне вывести какое-нибудь окошко с картинкой, пока программа
грузится?
Q-27 Как объявлять переменные, чтобы они были видны в других модулях
проекта.
Q-28 А как поместить свою иконку на taskbar, там где часы и
переключатель клавиатуры?
Q-29 Как форматировать денежные суммы, чтобы было видно всегда два
знака после запятой
Q-30 Как сделать плавно изменяющийся цвет заголовка окна, как в
MSOffice'95?
Q-31 Как сделать так, чтобы по Alt-F4 форма не просто закрывалась, а
выдавала запрос на сохранение?
Q-32 Как мне перекодировать строки из Win-кодировки в Dos-кодировку и
наоборот?
Q-33 Кaк yзнaть кaкиe фyнкции нaхoдятcя в DLL и кaк их иcпoльзoвaть?
Q-34 Как отловить события создания или удаления файлов другими
программами?
Q-35 Почему у меня record a : word; b : longint end; имеет размер
восемь байт вместо шести?
Q-36 Hе перерисовываются окна во время длинного цикла
Q-37 Как отследить "уход" курсора мыши с компоненты?
Q-38 Как мне запустить какую-нибудь программу
Q-39 Как правильно закрыть и удалить форму?
Q-40 Я создал объект TStrings, но при попытке обращения к нему выдается
ошибка.
Q-41 Мне надо добавить много строк в TListbox или в TCombobox или в
TMemo
Q-42 Как правильно создавать компоненты в run-time?
Q-43 Как мне запрограммировать непрямоугольную форму, например, как у
Norton CrashGuard, в форме щита?
Q-44 Как использовать свои курсоры в программе?
Q-45 Как ограничить перемещение курсора мыши какой-либо областью
экрана?
Q-46 Как сделать так, чтобы запущенная программа не была видна на
панели задач?
Q-47 Как из программы переключить раскладку клавиатуры?
Q-48 Как получить короткий путь файла если имеется длинный?
Q-49 String в PChar и обратно
Q-50 Как при наведении курсора на кнопку менять ее цвет?
Q-51 Как написать сервис для Windows NT?
Q-52 Как работать с реестром?
Q-53 Как выдвинуть дверцу CD-ROM'а?
Q-54 Как перехватывать клавиши, нажатые в окне другой программы? И
вообще, любые события
Q-55 Как сделать индикатор прогресса для длительного запроса?
Q-56 Как вызывать из 32-битной программы 16-битные DLL?
Q-57 Как получить набранный в Блокноте текст в свою пpогpаммку?
Q-58 Как скопировать экран в буфер обмена?
Q-59 Где взять подробную документацию по работе с RTF, TRichEdit?
Q-60 Как показать Hint для MenuItem?
Q-61 Как можно перетаскивать форму не только за заголовок?
Q-62 Как сделать прозрачным фон при выводе Canvas.TextOut?
Q-63 Как применить изменение в реестре без перезагрузки компьютера?
Q-64 Как добавить пункты в системное меню окна?
Q-65 Как в Мемо установить карет в нyжнyю позицию?
Q-66 Можно ли сделать так, чтобы в исполняемом файле программы
находился какой-нибудь звук в формате .wav
Q-67 Как сделать в меню список последних открытых файлов?
Q-68 Как узнать и поменять разрешение экрана?
Q-69 Какое событие происходит при минимизации окна?
Q-70 Как во время выполнения программы создать так называемый "array of
const"
Q-71 Как сохранить в ini файле настройки TFont?
Q-72 Как обратиться к определенному адресу физической памяти?
Q-73 Как закрыть внешнюю программу?
Q-74 Как загрузить из ImageList иконку приложения?
Q-75 Как использовать в качестве обработчика сообщения обычную
процедуру, а не метод объекта?
Q-76 Как отловить нажатие Enter в TEdit?
Q-77 В какой позиции Memo находится каретка?
Q-78 Как работать с графическими форматами, хотя бы самыми известными?
Q-79 Почему после RichEdit1.Lines.SaveToFile(name) в файле, кроме моего
текста, ещё всякий бред написан?
Q-80 Как работать с файлами архивов, хотя бы самыми распространенными?
Q-81 Как вставить картинку в TDrawGrid?
Q-82 Как использовать DirectX в своей программе?
Q-83 Как дождаться завершения программы, запущенной ShellExecute?
Q-84 Как использовать OpenGL в своей программе?
Q-85 Как в TMemo вставить дату в позицию каретки?
Q-86 Как отловить системную ошибку при операциях с файлами?
Q-87 Где достать процедуру типа "сумма прописью"?
Q-88 Как узнать, была ли создана ли определенная форма?
Q-89 Какие инструменты можно применить для коллективной разработки
проекта?
Q-90 Что такое Handle окна, и как его полyчить?
Q-91 Как можно обнаружить утечки памяти и ресурсов в программе?
Q-92 Как проиграть midi файл?
Q-93 Мне нужно заниматься разбором математических выражений
Q-94 Как обратиться к свойству по его имени?
Q-95 Как уменьшить размер исполняемого файла программы?
Q-96 Как нажать Ctrl+Del программным путем?
Q-97 Где достать всяких иконок, картинок для кнопок, etc. для своей
программы?
Q-98 Аналог Case для строк
Q-99 Как в TListBox пеpетаскивать итемы?
Q-100 Как отловить нажатие клавиш F1..F10?
Q-101 Как мне работать с файлами MS Word или таблицами MS Excel?
Q-102 Как записать в файл несколько TImage?
Q-103 Как показать текстовый файл в TLabel?
Q-104 Delphi 5.0 and Win2K
Q-105 Почему в консольных приложениях неправильно отображаются русские
буквы?
Q-106 В чем pазличия ShellExecute и CreateProcess?
Q-107 Как вставить картинку в StatusPanel?
Q-108 Как внедрить dll в другое приложение?
Q-109 Как показывать хинты для частично видимых элементов ListBox?
Q-110 Как центрировать по форме модальный диалог?
Q-111 Чем отличаются TLabel и TStaticText?
Q-112 Как издать звук через PC Speaker?
Q-113 Как корректнее завершать приложение- Terminate или MainForm.Close?
Q-114 Как узнать версию Windows?
Q-115 Как помигать Scroll Lock?
Q-116 Как из dll узнать узнать полный путь к этой dll.
Q-117 Как отобразить каталог?
Q-118 Как узнать кол-во цветов цветовой палитры?
Q-119 Как ввести текст в "чужой" Edit?
Q-120 Как заставить мигать кнопку приложения на AppBar?
Q-121 Как сделать программу без главной формы?
Q-122 Как убрать VerticalScrollBar из TListBox навсегда?
Q-123 Как показать диалог выбора директории?
Q-124 Как убрать из ListView горизонтальный скролбар навсегда?
Q-125 Кaк искать oкнo по части eгo нaзвaния?
Q-126 Как обнаружить активность юзера?
Q-127 Как yзнать текущую Ru/En pаскладкy клавиатypы?
Q-128 Как передать строку другому приложению?
Q-129 Как RichEdit сделать скролл на конец текста?
Q-130 Удаление файлов из временного каталога, безопасно ли?
Q-131 Как узнать состояние управляющих клавиш - Shift, Ctrl, Alt?
Q-132 Как сохранить всю форму в файл (как Delphi в *.dfm)?
Q-133 Как контрол может сам себя разрушить?
Q-134 Как отследить переход фокуса в приложении?
Q-135 Как заставить MediaPlayer крутить один и тот же клип?
Q-136 Как назначить процедуру собственному пункту системного меню?
Q-137 Какой класс окна у консоли?
Q-138 Какое сообщение надо отлавливать в Application.OnMessage для
отслеживания клавиши Alt (vk_menu)
Q-139 Как спрятать контрол, если известен его Handle?
Q-140 Как поменять иконку и стpокy в заголовке консольного окна?
Q-141 Как сделать окно без VCL?
Q-142 Как избежать повторного запуска моего приложения?
Q-143 Как записать массив в файл?
Q-144 Delphi 6 требует Proxies.pas?
Q-145 О библиотеке RxLib
Q-146 Как хранить настройки программ.
Q-147 Как вывести ProgresBar на StatusBar?
I-148 Список рекомендуемой литературы
Q-149 Как нажать клавиши в другом приложении?
Q-150 Как перетащить файлы из проводника в мою программу
Q-151 Как использовать в Дельфи API фyнкции
Q-152 Автоматическое определение кодировки текста
Q-153 Как помигать лампочками на клавиатуре?
Q-154 Как создать в runtime форму
Q-155 Как прочитать порт или записать в него.
Q-156 Как работать с битами?
Q-157 Как удалить непустой каталог?
Q-158 Как получить список файлов со всеми подкаталогами
Q-159 Как преобразовать unix time в TDateTime
Q-160 Как сделать .manifest для Windows XP
Q-161 Как узнать версию программы
Q-162 Как выключить или презагрузить компьютер
Q-163 Куда пропали те или другие компоненты в Д7
Q-164 Время работы Windows
==================

* Origin: Errare humanum est (2:450/143.25)

модемом входящий звонок

it's really nice to talk with you

Если во вpемя того как ты сидишь в интеpнете и по втоpой линии начинает
пpиходить звонок (т. н. услуга входящего вызова), можно это отловить и, скажем
скинуть?


* Origin: friendship is the most valuable thing humans have (2:5093/41.666)

FastReport, экспоpт в excel и гpафики в отчетах

Пpивет All!
Сабж возможен?
если да, то как?
пpи экспоpте в excel получается какая то дегенеpативная таблица с не поймешь чем.

Пока!
* Origin: icq: 147893926 [\f] [инквизиция] [DarVIN] (2:5020/2015.46)

Вpемя/дата в таблице в базе данных

Пpивет All!
сабж в ide выводится как 20:23 2.10.2005 а в runtime как 20:23 2.10.2005 20:23:43
что за глюк?

Пока!
* Origin: icq: 147893926 [\f] [инквизиция] [DarVIN] (2:5020/2015.46)

Re: Explorer ToolBand

From: Alexander Grischenko <gralex [@] ml.lv>


Hе помогает. Может еще какие-то идеи будут?

Oleg Chensky пишет:
> Сделать всё что можно Transparent и на OnResize сказать Invalidate.


>>

>>Explorer ToolBand

>>

>>Пишу свой Тулбар для Windows Explorer. за основу взял пример, описанный на

>>http://www.euromind.com/iedelphi . Все классно, но столкнулся с такой

>>проблемой:

>>

>>у создавшегося тулбара весь фон одного цвета, а в Win XP, например, фон

>>тулбаров переливается слева на право.

>>Как обойти проблему?

>>

>>delphir [@] times.lv

>>

>>==================================


--
Alexander Grischenko
<gralex(at)ml.lv>

* Origin: Demos online service (2:5020/400)