Программа для учета времени работы на компьютере. Проверьте пожалуйста код

e8gen · #1 09.02.2011, 12:18

Мне нужно, чтобы программа при выключении windows записывала в файл текущие дату/время. При выходе из программы она записывает, а при выключении винды нет! Что делать? Подскажите!
Вот код:

Код:

unit unitSysUpt;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellApi, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Timer1: TTimer;
    Edit1: TEdit;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure IconCallBackMessage(var Mess: TMessage); message WM_USER + 100;
  end;

var
  Form1: TForm1;
  log: TextFile;
  t: integer;

implementation

{$R *.dfm}

//при открытии приложения
procedure TForm1.FormCreate(Sender: TObject);
var nid: TNotifyIconData;
begin
//создание иконки в трее
with nid do
 begin
  cbSize := SizeOf(TNotifyIconData);
  Wnd := Form1.Handle;
  uID := 1;
  uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  uCallbackMessage := WM_USER + 100;
  hIcon := Application.Icon.Handle;
  StrPCopy(szTip, 'System Uptime');
 end;
Shell_NotifyIcon(NIM_ADD, @nid);
//загрузка файла log.txt
AssignFile(log,'log.txt');
try
Append(log);
except
ReWrite(log);
end;
//запись в файл
WriteLn(log,'---------------');
WriteLn(log,'Дата включения: '+DateToStr(Now));
WriteLn(log,'Время включения: '+TimeToStr(Now));
WriteLn(log,'---------------');
//закрытие файла
CloseFile(log);
//показ содержимого файла
Memo1.Lines.LoadFromFile('log.txt');
//Memo и Edit только для чтения
Memo1.ReadOnly:=true;
Edit1.ReadOnly:=true;
//кнопка выключения не доступна
Button2.Enabled:=false;
end;

procedure TForm1.IconCallBackMessage(var mess: TMessage);
var mouse: TMouse;
begin
 case Mess.lParam of
  //при нажатии лев. кн. мыши на иконку в трее показывать окно
  WM_LBUTTONDOWN: Form1.Visible:=true;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//при нажатии на кнопку скрывать окно
Form1.Visible:=false;
//сделать доступной кнопку выключения
Button2.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
//показ времени работы
t := GetTickCount;
Edit1.Text := 'Время работы: ' +
IntToStr(t div 60000) + ' мин ' +
IntToStr((t mod 60000) div 1000) + ' сек ' +
IntToStr(t mod 1000) + ' мсек';
end;

//при нажатии на кнопку выключения
procedure TForm1.Button2Click(Sender: TObject);
begin
//закрыть приложение
Form1.Close;
end;

//при закрытии приложения
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var nid: TNotifyIconData;
begin
//загрузка файла log.txt
AssignFile(log,'log.txt');
try
Append(log);
except
ReWrite(log);
end;
//запись в файл
WriteLn(log,'Дата выключения: '+DateToStr(Now));
WriteLn(log,'Время выключения: '+TimeToStr(Now));
WriteLn(log,'---------------');
WriteLn(log,'Время работы: '+
IntToStr(t div 60000) + ' мин ' +
IntToStr((t mod 60000) div 1000) + ' сек ' +
IntToStr(t mod 1000) + ' мсек');
WriteLn(log,'---------------');
//закрытие файла
CloseFile(log);
//убрать иконку из трея
with nid do
 begin
  cbSize := SizeOf( TNotifyIconData );
  Wnd := Form1.Handle;
  uID := 1;
  uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  uCallbackMessage := WM_USER + 100;
  hIcon := Application.Icon.Handle;
  StrPCopy(szTip, 'System Uptime');
 end;
Shell_NotifyIcon( NIM_DELETE, @nid );
end;

end.

GriLab · #2 09.02.2011, 13:47

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

e8gen · #3 11.02.2011, 13:44

GriLab, спасибо за совет. Я записал операторы выхода из программы в обработчик события FormCloseQuery вместо FormClose и теперь все работает! Вот что у меня получилось:

Код:

unit unitSysUpt;

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShellApi, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Timer1: TTimer;
    Edit1: TEdit;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure IconCallBackMessage(var Mess: TMessage); message WM_USER + 100;
  end;

var
  Form1: TForm1;
  log: TextFile;
  time: integer;
  nid: TNotifyIconData;

implementation

uses unitAbout;

{$R *.dfm}

//при открытии формы
procedure TForm1.FormCreate(Sender: TObject);
begin
//создание иконки в трее
with nid do
 begin
  cbSize := SizeOf(TNotifyIconData);
  Wnd := Form1.Handle;
  uID := 1;
  uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  uCallbackMessage := WM_USER + 100;
  hIcon := Application.Icon.Handle;
 end;
Shell_NotifyIcon(NIM_ADD, @nid);
//загрузка файла log.txt
AssignFile(log,'log.txt');
try
Append(log);
except
ReWrite(log);
end;
//запись в файл
WriteLn(log,'Компьютер включен: '+DateToStr(Now)+' '+TimeToStr(Now));
//закрытие файла
CloseFile(log);
//показ содержимого файла
Memo1.Lines.LoadFromFile('log.txt');
//Memo и Edit только для чтения
Memo1.ReadOnly:=true;
Edit1.ReadOnly:=true;
//кнопка выключения не доступна
Button2.Enabled:=false;
end;

procedure TForm1.IconCallBackMessage(var mess: TMessage);
var mouse: TMouse;
begin
 case Mess.lParam of
  //при двойном нажатии лев. кн. мыши на иконку в трее показывать окно
  WM_LBUTTONDBLCLK: Form1.Visible:=true;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//скрыть окно
Form1.Visible:=false;
//сделать доступной кнопку выключения
Button2.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
//показ времени работы
time := GetTickCount;
Edit1.Text := 'Время работы: ' +
IntToStr(time div 60000) + ' мин ' +
IntToStr((time mod 60000) div 1000) + ' сек ' +
IntToStr(time mod 1000) + ' мсек';
with nid do StrPCopy(szTip, 'Время работы: ' +
IntToStr(time div 60000) + ' мин ' +
IntToStr((time mod 60000) div 1000) + ' сек ' +
IntToStr(time mod 1000) + ' мсек');
Shell_NotifyIcon(NIM_MODIFY, @nid);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//закрыть приложение
Form1.Close;
end;

//при закрытии формы
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
//загрузка файла log.txt
AssignFile(log,'log.txt');
try
Append(log);
except
ReWrite(log);
end;
//запись в файл
WriteLn(log,'Компьютер выключен: '+DateToStr(Now)+' '+TimeToStr(Now));
WriteLn(log,'Время работы: '+
IntToStr(time div 60000) + ' мин ' +
IntToStr((time mod 60000) div 1000) + ' сек ' +
IntToStr(time mod 1000) + ' мсек');
WriteLn(log,'******************************');
//закрытие файла
CloseFile(log);
//убрать иконку из трея
Shell_NotifyIcon(NIM_DELETE, @nid);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//загрузка файла log.txt
AssignFile(log,'log.txt');
try
Append(log);
except
ReWrite(log);
end;
//запись в файл
WriteLn(log,'Метка: '+DateToStr(Now)+' '+TimeToStr(Now));
//закрытие файла
CloseFile(log);
//показ содержимого файла
Memo1.Lines.LoadFromFile('log.txt');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
//показ окна "О программе"
Form2.Visible:=true;
Form1.Enabled:=false;
end;

end.

Может поможете теперь оптимизировать код?

А то я не знаю, что тут еще можно сделать...

GriLab · #4 11.02.2011, 16:29

Не знаю как другие делают, но я бы эти функции и процедуры бы вынес отдельно: создание иконки в трее, удаление иконки из трея, открытие лог-файла, закрытие лог-файла, перевод миллисекунд в строку вида HH:MM:SS. Вот что я имею в виду

Вот посмотри: http://delphisources.ru/pages/faq/ba...wn_detect.html

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты