Статья по Delphi.

Размещение значка приложения в System Tray

Часто программисту приходится сталкиваться с задачей написания приложения, работающего в фоновом режиме и не нуждающегося в месте на Панели задач. Если вы посмотрите на правый нижний угол рабочего стола Windows, то наверняка найдете там приложения, для которых эта проблема решена: часы, переключатель раскладок клавиатуры, регулятор громкости и т. п. Ясно, что, как бы вы не увеличивали и не уменьшали формы своего приложения, попасть туда обычным путем не удастся. Способ для этого предоставляет Shell API.
Те картинки, которые находятся на System Tray — это действительно просто картинки, а не свернутые окна. Они управляются и располагаются панелью System Tray. Она же берет на себя еще две функции: показ подсказки для каждого из значков и оповещение приложения, создавшего значок, обо всех перемещениях мыши над ним.
Весь API System Tray состоит из 1 (одной) функции:

function Shell_NotifyIcon(dwMessage: DWORD;
IpData: PNotifylconData): BOOL; PNotifylconData = TNotifylconData; TNotifylconData = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hlcon: HICON;
szTip: array [0..63] of AnsiChar;
end;

Параметр dwMessage определяет одну из операций: NIM_ADD означает добавление значка в область, NIM_DELETE — удаление, NIM_MODIFY — изменение.
Ход операции зависит от того, какие поля структуры TNotifyiconData будут заполнены.
Обязательным для заполнения является поле cbsize — там содержится размер структуры. Поле wnd должно содержать дескриптор окна, которое будет оповещаться о событиях, связанных со значком. Идентификатор сообщения Windows, которое вы хотите получать от системы о перемещениях мыши над значком, запишите в поле uCallbackMessage. Если вы хотите, чтобы при этих перемещениях над вашим значком показывалась подсказка, то задайте ее текст в поле szTip. В поле UID задается номер значка — каждое приложение может поместить на System Tray сколько угодно значков. Дальнейшие операции вы будете производить, задавая этот номер. Дескриптор помещаемого значка должен быть задан в поле hIcon. Здесь вы можете задать значок, связанный с вашим приложением, или загрузить свой — из ресурсов.
Примечание
Изменить главный значок приложения можно в диалоговом окне Project/ Options на странице Application. Он будет доступен через свойство Application.Icon. Тут же можно отредактировать и строку для подсказки — свойство Application.Title.
Наконец, в поле uFlags вы должны сообщить системе, что именно вы от нее хотите, или, другими словами, какие из полей hicon, uCaiibackMessage и szTip вы на самом деле заполнили. В этом поле предусмотрена комбинация трех флагов: NIF_ICON, NIF_MESSAGE и NIF_TIP. Вы можете заполнить, скажем, поле szTip, но если вы при этом не установили флаг NIF_TIP, созданный вами значок не будет иметь строки с подсказкой.
Два приведенных ниже метода иллюстрируют сказанное. Первый из них создает значок на System Tray, а второй — уничтожает его.

const WM_MYTRAYNOTIFY = WMJJSER + 123;
procedure TForml.CreateTraylcon(n:Integer);
var nidata : TNotifyiconData;
begin
with nidata do
begin
cbSize := SizeOf{TNotifyiconData) ;
Wnd := Self.Handle;
uID := n;
uFiags := NIF_ICON or NIF_MESSAGE or NIFJTIP;
uCallBackMessage := WM_MYTRAYNOTIFY;
hicon := Application.Icon.Handle;
szTip := 'THis is Traylcon Example';
end;
Shell_NotifyIcon(NIM_ADD, @nidata);
end;
procedure TForml.DeleteTraylcon(n:Integer);
var nidata : TNotifylconData; begin
with nidata do
begin
cbSize := SizeOf(TNotifylconData);
Wnd := Self.Handle; uID := n; end;
Shell_NotifyIcon(NIM_DELETE, @nidata);
end;

Примечание
He забывайте уничтожать созданные вами значки на System Tray. Это не делается автоматически даже при закрытии приложения. Значок будет удален только после перезагрузки системы.
Внешний вид значка, помещенного нами на System Tray, ничем не отличается от значков других приложений (рис. 31.1).
[]
Рис. 31.1. Над значком, помещенным на панель System Tray, видна строка подсказки
Сообщение, задаваемое в поле uCallbackMessage, по сути дела является единственной ниточкой, связывающей вас со значком после его создания. Оно объединяет в себе несколько сообщений. Когда к вам пришло такое сообщение (в примере, рассмотренном выше, оно имеет идентификатор WM_MYTRAYNOTIFY), поля в переданной в обработчик структуре типа TMessage распределены так. Параметр wParam содержит номер значка (тот самый, что задавался в поле uID при его создании), а параметр LParam — идентификатор сообщения от мыши, вроде WM_MOUSEMOVE, WM_LBUTTONDOWN и т. п. К сожалению, остальная информация из этих сообщений теряется. Координаты мыши в момент события придется узнать, вызвав функцию API GetCursorPos:

procedure TForml.WMICON(var msg: TMessage);
var P : TPoint; begin case msg.LParam of
WM_LBUTTONDOWN:
begin
GetCursorPos(p);
SetForegroundWindow(Application.MainForm.Handle); PopupMenul.Popup(P.X, P.Y);
end;
WM_LBUTTONUP :
end;
end;

Обратите внимание, что при показе всплывающего меню недостаточно просто вызвать метод Popup. При этом нужно вынести главную форму приложения на передний план, в противном случае она не получит сообщений от меню.
Теперь решим еще две задачи. Во-первых, как сделать, чтобы приложение минимизировалось не на Панель задач (TaskBar), а на System Tray? И более того — как сразу запустить его в минимизированном виде, а показывать главную форму только по наступлении определенного события (приходу почты, наступлению определенного времени и т. п.).
Ответ на первый вопрос очевиден. Если минимизировать не только окно главной формы приложения (Application.MainForm.Handle), но и окно приложения (Application.Handle), то приложение полностью исчезнет "с экранов радаров". В этот самый момент нужно создать значок на панели System Tray. В его всплывающем меню должен быть пункт, при выборе которого оба окна восстанавливаются, а значок удаляется.
Чтобы приложение запустилось сразу в минимизированном виде и без главной формы, следует к вышесказанному добавить установку свойства Application.showMainForm в значение False. Здесь возникает одна сложность — если главная форма создавалась в невидимом состоянии, ее компоненты будут также созданы невидимыми. Поэтому при первом ее показе установим их свойство visible в значение True. Чтобы не повторять это дважды, установим флаг — глобальную переменную shownonce:

procedure TForml.HideMainForm;
begin
Appiication.showMainForm := False;
ShowWindow(Application.Handle, SW_HIDE);
ShowWindow(Application.MainForm.Handle, SW_HIDE);
end;
procedure TForml.RestoreMainForm;
var i,j : Integer;
begin
Appiication.showMainForm := True;
ShowWindow(Application.Handle, SW_RESTORE); ShowWindow(Application.MainForm.Handle, SW_RESTORE);
if not ShownOnce then begin
for I := 0 to Application.MainForm.ComponentCount -1 do if Application.MainForm.Components[I] is TWinControl then with Application.MainForm.Components[I] as TWinControl do if Visible then
begin
ShowWindow(Handle, SW_SHOWDEFAULT);
for J := 0 to ComponentCount -1 do if Components[J] is TWinControl then
ShowWindow((Components[J] as TWinControl).Handle, SW_SHOWDEFAULT);
end;
ShownOnce := True;
end;
end;
procedure TForml.WMSYSCOMMAND(var msg: TMessage);
begin inherited;
if (Msg.wParam=SC_MINIMIZE) then
begin
HideMainForm; CreateTraylcon(l) ;
end;
end;
procedure TForml.FileOpenltemlClick(Sender: TObject); begin
RestoreMainForm;
DeleteTraylcon(l);
end;

Теперь у вас в руках полноценный набор средств для работы с панелью System Tray. В заключение необходимо добавить, что все описанное реализуется не в операционной системе, а в оболочке ОС — Проводнике (Explorer). В принципе, и Windows NT 4/2000, и Windows 95/98 допускают замену оболочки ОС на другие, например DashBoard или LightStep. Там функции панели System Tray могут быть не реализованы или реализованы через другие API. Впрочем, случаи замены оболочки достаточно редки.

Присылайте свои статьи по адресу delphi-faq@list.ru с темой 'Clause' (без кавычек), и они будут опубликованы в ближайших выпусках рассылки. Большая просьба: статью оформляйте в -txt или -doc формате и используйте -zip или -rar сжатие (без самораспаковки).

Новые вопросы:

12. Привет. Может, кому-нибудь из читателей, удалось написать утилиту, показывающую все активные TCP/IP соединения (аналог Netstat) на Delphi без использования Fnugry Netstat Components. Поделитесь пожалуйста исходником, а то дядька Google мне отказался с этим помочь. [Ответить].

13. Где можно скачать Delphi 6? [Ответить].

14. Скажите, как узнать занятость принтера и передать задачу на другой принтер сети! [Ответить].

15. zdrastvuyte.Mojete skazat kak ya mogu vibrat komponent iz drugogo Application? Naprimer V drugom App. ya ispolzoval s odnogo Edit-a ili on mojet bit ne vizualnim. I xochu shto dobavit kod novuyu Application( pervomu Form-u OnCreate ) shtobi on avtomaticheski vibral tu Componentu kakuyu ya dam v kode. Zaranee blogodoren. [Ответить].
От ведущего: вопрос пришёл именно в такой форме. Попытайтесь прочитать! ;)

16. Расскажите или хотя бы намекните как работать с тенями и отражениями в 3D графике (DirectX /OpenGL). Буду благодарен любому ответу. [Ответить].

17. Здравствуйте. Как двойным щелчком мышки по URL, скопоровать его в TMemo? [Ответить].

Поступившие ответы:

11. (Создание иконки программы с системном трее).
[Отвечает: Садовников Владимир]. Чтобы сделать аналаговые часы, можешь воспользоваться канвой Canvas формы или вообще любого графического объекта (если она у него имеется). Дальше вспоминаем геометрию.

Пусть угол L-угол поворота стрелки (В РАДИАНАХ!!!), Length - длина, а X,Y - её ось вращения. Тогда координаты конца стрелки:
X1=X+Cos(Pi/2-L)*Length=X+Sin(L)*Length
Y1=Y+Sin(Pi/2-L)*Length=Y+Cos(L)*Length

Ещё надо учесть, что ось Y направлена не снизу вверх, как принято в геометрии, а сверху вниз. Поэтому координаты будут такими:
X1=X+Sin(L)*Length
Y1=Y-Cos(L)*Length

Потом пихаешь на форму компонент TTimer с вкладки System, задаёшь ему интервал не более 100 миллисекунд и на событии OnTimer пишешь примерно следующее:

procedure TForm1.Timer1Timer(Sender: TObject);
var
H,M,S,MS:Word;

procedure DrawAxis(X,Y,Angle,Length:Integer);
var
X1,Y1:Integer;
begin
Canvas.MoveTo(X,Y);
X1:=X+Round(Sin(Angle*pi/180)*Length); //при расчёте координат надо учитывать, что угол
Y1:=Y-Round(Cos(Angle*pi/180)*Length); //задан в градусах
Canvas.LineTo(X1,Y1);
end;

begin
Canvas.Rectangle(0,0,200,200);
DecodeTime(Now,H,M,S,MS);
DrawAxis(100,100,(H mod 12)*30,60); //часовая стрелка (надо учесть, что отображается 12 часов, а не 24, поворот на 30 градусов)
DrawAxis(100,100,M*6,80); //минутная стрелка (каждый поворот - на 6 градусов)
DrawAxis(100,100,S*6,100); //секундная стрелка
end;

Теперь работа с треем. Для этого нужно включить модуль ShellApi.
Объявляешь какое-нибудь пользовательское сообщение:
const
WM_NOTIFYTRAYICON = WM_USER + 2;

Вот весь код (надо ещё пихнуть на форму какой-нибудь Button1):

unit Timer;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ShellAPI, AppEvnts, StdCtrls;

const
WM_NOTIFYTRAYICON = WM_USER + 2;

type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
ApplicationEvents1: TApplicationEvents;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
// эта процедура будет вызываться при каких-либо действиях с иконкой в трее
procedure WMTRAYICONNOTIFY(var Msg: TMessage); message WM_NOTIFYTRAYICON;
public
{ Public declarations }
Tray: TNotifyIconData; // информация об иконке
TrayIcon: TIcon; //иконка в трее
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

// отрисовываем стрелки (лучше сделать для данного примера форму размером 200x200)
procedure TForm1.Timer1Timer(Sender: TObject);
var
H,M,S,MS:Word;

procedure DrawAxis(X,Y,Angle,Length:Integer);
var
X1,Y1:Integer;
begin
Canvas.MoveTo(X,Y);
X1:=X+Round(Sin(Angle*pi/180)*Length);
Y1:=Y-Round(Cos(Angle*pi/180)*Length);
Canvas.LineTo(X1,Y1);
end;

begin
Canvas.Rectangle(0,0,200,200);
DecodeTime(Now,H,M,S,MS);
DrawAxis(100,100,(H mod 12)*30,60);
DrawAxis(100,100,M*6,80);
DrawAxis(100,100,S*6,100);
end;

//обрабатываем события на иконке в трее
procedure TForm1.WMTRAYICONNOTIFY(var Msg: TMessage);
begin
case Msg.LParam of
WM_LBUTTONDOWN:
begin
Activate;
Visible:=True;
end;
end;
end;

// добавляем иконку в трей
procedure TForm1.FormCreate(Sender: TObject);
begin
TrayIcon := Application.Icon;
Tray.cbSize := SizeOf(TNotifyIconData);
Tray.Wnd := Form1.Handle;
Tray.uID := 1;
Tray.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Tray.uCallBackMessage := WM_NOTIFYTRAYICON;
Tray.hIcon := TrayIcon.Handle;
Tray.szTip := 'Простые часы';
Shell_NotifyIcon(NIM_ADD, @Tray);
end;

// при удалении формы её надо удалить из трея
procedure TForm1.FormDestroy(Sender: TObject);
begin
Tray.cbSize := SizeOf(TNotifyIconData);
Tray.Wnd := Form1.Handle;
Tray.uID := 1;
Shell_NotifyIcon(NIM_DELETE, @Tray);
end;

// нажатие на кнопку прячет приложение в трей
procedure TForm1.Button1Click(Sender: TObject);
begin
Visible:=False;
end;

end.

[Отвечает: Андрей Лучников]. Самый простой способ - воспользоваться rxLib, хотя есть и другие способы. Если надо, чтоб программа стартовала сразу в Трее, то в в dpr (запускающем модуле проги) указать Application.ShowMainForm:=False;

8. (Передача данных по порту USB). [Отвечает: Садовников Владимир]. Насчёт USB точно не знаю, но могу привести пример, как я работал с СОМ.

Каждый порт в Windows можно представить как файл. Для него и есть специальные функции:
CreateFile, WriteFile, ReadFile. Только как имя файла для функции надо задать имя порта: 'COM1', 'COM2' и т.д. Скорее всего, тебе придётся использовать что-то вроде 'USB001' и т.д.

Может, это тебе чем-нибудь поможет (отрывочек из одной моей проги, информацию смотрел, кажется, в MSDN Library (April 2000))... Пример работает!

type
TComThread = class(TThread)
public
RxQueue,TxQueue:TCyclicQueue;

constructor Create(Port:Integer;Speed:Integer;BufferSize:Integer);
destructor Destroy;override;
private
{ Private declarations }
idComDev:THandle;
dcbCom:TDCB;
FInitialized:Boolean;
FBufSize:Integer;
osRead,osWrite:TOverlapped;
function ReadCommBlock(var Data:array of Byte):Integer;
protected
procedure Execute; override;
published
property Initialized:Boolean read FInitialized;
property BufSize:Integer read FBufSize;
end;

implementation

{ TComThread }

constructor TComThread.Create(Port:Integer;Speed:Integer;BufferSize:Integer);
var
Name:string;
CommTimeOuts:TCommTimeouts;
Res:Boolean;
begin
inherited Create(True);

FInitialized:=False;
FBufSize:=BufferSize;

Name:='COM'+IntToStr(Port);

RxQueue:=TCyclicQueue.Create(FBufSize);
TxQueue:=TCyclicQueue.Create(FBufSize);

idComDev:=CreateFile(PChar(Name),
GENERIC_READ or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
0);

if (idComDev=$FFFFFFFF) then
Exit;

SetCommMask(idComDev,EV_RXCHAR or EV_TXEMPTY) ;// get any early notifications
SetupComm(idComDev,FBufSize,FBufSize) ; // setup device buffers
// purge any information in the buffer
PurgeComm(idComDev,PURGE_TXABORT or PURGE_RXABORT or
PURGE_TXCLEAR or PURGE_RXCLEAR);

// set up for overlapped I/O
with CommTimeouts do
begin
ReadIntervalTimeout:= $FFFFFFFF;
ReadTotalTimeoutMultiplier:=0;
ReadTotalTimeoutConstant:=1000;
// CBR_9600 is approximately 1byte/ms. For our purposes, allow
// double the expected time per character for a fudge factor.
WriteTotalTimeoutMultiplier:=2*Speed div 9600;
WriteTotalTimeoutConstant:=0;
end;
SetCommTimeouts(idComDev,CommTimeOuts);

with dcbCom do
begin
DCBlength:=SizeOf(TDCB);
BaudRate:=Speed;
ByteSize:=8;
Parity:=NOPARITY;
StopBits:=ONESTOPBIT;
end;

Res:=SetCommState(idComDev,dcbCom);

if (not Res) then
CloseHandle(idComDev);

FInitialized:=Res;
end;

destructor TComThread.Destroy;
begin
Suspend;

SetCommMask(idComDev,0);
EscapeCommFunction(idComDev,CLRDTR);

// purge any outstanding reads/writes and close device handle
PurgeComm(idComDev,PURGE_TXABORT or PURGE_RXABORT or
PURGE_TXCLEAR or PURGE_RXCLEAR);

CloseHandle(idComDev);

RxQueue.Destroy;
TxQueue.Destroy;

inherited Destroy;
end;

procedure TComThread.Execute;
var
dwEvtMask:LongWord;
nLength:LongWord;
ComBuffer:array[0..255] of Byte;
numByte:LongWord;
begin
{ Place thread code here }
if (FInitialized) then
begin
ZeroMemory(@osRead,SizeOf(TOverlapped));

// create I/O event used for overlapped read
osRead.hEvent:=CreateEvent(nil, // no security
True, // explicit reset req
False, // initial event reset
nil) ; // no name

if (osRead.hEvent=0) then
Exit;

if (not SetCommMask(idComDev,EV_RXCHAR or EV_TXEMPTY)) then
Exit;

while (True) do
begin
dwEvtMask:=0;

WaitCommEvent(idComDev,dwEvtMask,nil); //NULL - os

if ((dwEvtMask and EV_RXCHAR) <> 0) then
repeat
nLength:=ReadCommBlock(ComBuffer);
if (nLength>0) then
RxQueue.PushFrame(ComBuffer,nLength);
until (nLength<=0);

if ((dwEvtMask and EV_TXEMPTY) <> 0) then
begin
if TxQueue.PopFrame(ComBuffer,nLength,256) then
WriteFile(idComDev,ComBuffer,nLength,numByte,@osWrite);
end;
end;
// get rid of event handle
CloseHandle(osRead.hEvent);
end;
end;

function TComThread.ReadCommBlock(var Data: array of Byte): Integer;
var
fReadStat:Boolean;
ComStat:TComStat;
dwErrorFlags:LongWord;
dwLength:LongWord;
dwError:LongWord;
nMaxLength:LongWord;
begin
// only try to read number of bytes in queue
ClearCommError(idComDev,dwErrorFlags,@ComStat) ;
nMaxLength:=Length(Data);
if (nMaxLength<=ComStat.cbInQue) then
dwLength:=nMaxLength
else
dwLength:=ComStat.cbInQue;

if (dwLength > 0) then
begin
fReadStat:=ReadFile(idComDev,Data,dwLength,dwLength,@osRead);
if (not fReadStat) then
begin
if (GetLastError=ERROR_IO_PENDING) then
begin
// We have to wait for read to complete.
// This function will timeout according to the
// CommTimeOuts.ReadTotalTimeoutConstant variable
// Every time it times out, check for port errors
while(not GetOverlappedResult(idComDev,osRead,dwLength,True)) do
begin
dwError:=GetLastError();
if (dwError<>ERROR_IO_INCOMPLETE) then
begin
// an error occurred, try to recover
ClearCommError(idComDev,dwErrorFlags,@ComStat);
if (dwErrorFlags>0) then
begin
{szError:='I/O Error <CE-'+IntToStr(dwErrorFlags)+'>!';
Debug.AddString(szError);}
end;
end;
end;
end
else
begin
// some other error occurred
dwLength:=0;
ClearCommError(idComDev,dwErrorFlags,@ComStat);
if (dwErrorFlags > 0) then
begin
end;
end;
end;
end;
Result:=dwLength;
end;

end.

[Отвечает: Alexander Prishchepa]. Ты полез в страшные дебри!!! Могу сказать одно. Нет универсального способа. С USB контроллером должен поставляться драйвер и, если это для разработчиков, то API к этому драйверу. Я по работе имел дело с контроллером Cypress FX2. К нему шел заголовочный файл (.h) и библиотека (.lib) для С++. Поэтому из Delphi это не реально. Пришлось переквалифицироваться под BCB. Правда, существует еще такой пакет - Jungo WinDriver. Это универсальная обертка под железо. В ней можно создать тестовый, консольный проект на Delphi, а потом уж сидеть и смотреть, что из этого вышло. Пробуй, смотри. P.S. Будь добр, сообщи мне с каким контроллером тебе надо работать, а так-же его характеристики (USB 1.1 или 2.0 Full Speed или High Speed).

9. (Программа для имитации мультимедиа-клавиатуры). [Отвечает: Садовников Владимир]. Насчёт проги.
Посмотри функции SetWindowsHookEx, CallNextHookEx и UnhookWindowsHookEx. Только придётся писать DLL-ку. Вот пример:

library Dll;

uses
SysUtils,
Windows,
Messages;

{$R *.RES}

var SysHook:HHook=0;
Wnd:HWnd=0;

function SysMsgProc(Code:Integer;wParam:Word;iParam:LongInt):
LongInt;stdcall;
var
F:THandle;
S:string;
NumWritten:LongWord;
KeyState:TKeyboardState;

begin
if (Code=HC_ACTION) then
begin
if ((iParam shr 16) and KF_UP)=0 then //клавиша была отпущена?
begin
if (iParam and $FFFF)=VK_F5 then
MessageBox(0,'F5 pressed','','MB_OK);
end;
end;

Result:=CallNextHookEx(SysHook,Code,wParam,iParam); //вызываем следующий обработчик
end;

procedure RunStopHook(State:Boolean) export; stdcall;
begin
if State then
SysHook:=SetWindowsHookEx(WH_KEYBOARD,@SysMsgProc,hInstance,0)
else
begin
UnhookWindowsHookEx(SysHook);
SysHook:=0;
end;
end;

exports RunStopHook index 1;

begin
end.

Компилируем библиотеку. Теперь пишем саму программу:

program KeyLogger;
//{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;

procedure RunStopHook(State:Boolean);external 'Dll.dll';

begin
// Insert user code here
RunStopHook(True);
Sleep(INFINITE);
RunStopHook(False);
end.

Универсальности относительно проигрывателей тут трудно достичь.

Нужно знать:
1) Как именуются окна у проигрывателей (тогда можно посылать этим окнам различные сообщения).
2) Какие сообщения заставляют их делать те или иные действия (кажется, для BS-Player'а как приложение есть C-заголовочный файл со всеми пользовательскими сообщениями, на которые он реагирует соответственно). Можно извратиться и воспользоваться командой ShellExecute, но это в особых случаях, когда заведомо известно имя проигрываемого файла.

10. (Определение размера файла, большего 10 Gb). [Отвечает: Садовников Владимир]. По-моему, проблема в том, что Integer может содержать в себе значение длины файла только максимум в 2 Гб, да и в файловой системе FAT32 нет файлов больше 2 Гб. Однако попробуй что-то вроде GetFileSizeEx. В MSDN она описана как:

BOOL GetFileSizeEx(
HANDLE hFile, // handle to file
PLARGE_INTEGER lpFileSize // file size
);

В Delphi5, например, нет описания этой функции. Естественно, она появилась только в Windows2000. Но её легко подключить:

function GetFileSize(hFile:THandle, var Int:Int64):Boolean;external 'kernel32.dll';stdcall;

Вот, собственно, говоря, и всё...

[Отвечает: Sandro]. Размер файл а привяза к размеру блока, увелич размер блока 4Кб (кстати точнее все равно глупо даже НТФС блок 4Кб) или больше, и тогда размер фалйла будет равен GetFileSize*РазмерБлока.

[Отвечает: Alexander Prishchepa]. var
hndFile:HWND;
dwHigh,dwLow:DWORD;
................................................................
hndFile:=FileOpen('h:\aaa.dat',fmOpenRead);
dwLow:=GetFileSize(hndFile,@dwHigh);
Label1.Caption:=Format('Длина файла: %u',[dwHigh*4294967296+dwLow]);

Вы также можете ответить на предыдущие вопросы. Поскольку на них уже ответили как минимум раз, они больше не публикуются в рассылке. Но если вы можете что-то добавить к ответам других, пожалуйста, отвечайте - ответы будут опубликованы. Найти предыдущие вопросы вы можете в архиве рассылки: http://subscribe.ru/archive/comp.soft.prog.delphifaq/, либо на сайте рассылки (http://www.delphi-faq.fatal.ru).

Юмор:

Программист ночью сидит за компом, в отладке. К нему подходит сынок, долго смотрит в монитор, потом смотрит в окошко и кричит:
- Папа, папа! В окошке НЛО зависло!
Отец, не отрываясь:
- Ну вот, как всегда! Ставили бы Линукс - не зависло бы!
[Прислал: Садовников Владимир]

Мышь. Оптическая. С прицелом.

Коврик для мышки выполнил недопустимую операцию и будет свернут.

- В кого бы вы выстрелили, если бы оказались в одном лифте с Усамой Бен Ладеном, Гитлером, Сталиным и Билл Гейтсом и у вас был бы один револьвер с двумя патронами?
- В Гейтса два раза, чтобы уж наверняка...

Разговаривают два активных пользователя Сети:
- Ну как дела?
- Да как тебе сказать: все нормально, только пальцы болят.
- А с чего вдруг?
- Да вчера с друзьями в чате встретились, так всю ночь песни орали.

Присылайте свои "компьютерные" анекдоты по этой ссылке: delphi-faq@list.ru и они обязательно будут опубликованы!

Сайт рассылки: http://www.delphi-faq.fatal.ru E-mail: Delphi-FAQ@list.ru