• Главная
• В избранное
• Наш E-MAIL
• Добавить материал
• Нашёл ошибку
• Вниз

Какие функции Windows API позволяют получить переменные DOS?

Функция GetEnvironmentStrings возвращает адрес памяти со средой текущего процесса. Все переменные возвращаются в виде строк, оканчивающихся нулем. Набор строк терминируется двумя нулями.

Функция GetEnvironmentVariable возвращает значения переменных среды опрашиваемого процесса. Величина также возвращается в виде строки с завершающим нулем.

Как я могу сменить системное время Windows 95 из программы, написанной на Delphi 2.0?

Вот правильное решение:

//*************************************************************************

// Функция (раздел Public) SetPCSystemTime изменяет системную дату и время.

// Параметр(ы)          :      tDati   Новая дата и время

// Возвращаемые значения:      True – успешное завершение

//                             False – метод не сработал

//*************************************************************************

function SetPCSystemTime(tDati: TDateTime): Boolean;

var

 tSetDati: TDateTime;

 vDatiBias: Variant;

 tTZI: TTimeZoneInformation;

 tST: TSystemTime;

begin

 GetTimeZoneInformation(tTZI);

 vDatiBias := tTZI.Bias / 1440;

 tSetDati := tDati + vDatiBias;

 with tST do begin

  wYear:= StrToInt(FormatDateTime('yyyy', tSetDati));

  wMonth:= StrToInt(FormatDateTime('mm', tSetDati));

  wDay:= StrToInt(FormatDateTime('dd', tSetDati));

  wHour:= StrToInt(FormatDateTime('hh', tSetDati));

  wMinute:= StrToInt(FormatDateTime('nn', tSetDati));

  wSecond:= StrToInt(FormatDateTime('ss', tSetDati));

  wMilliseconds:= 0;

 end;

 SetPCSystemTime:= SetSystemTime(tST);

end;

Я провел небольшое исследование, и вот что я выяснил:

При закрытии приложения (используя системное меню или вызывая метод закрытия формы), возникают следующие события:

1. FormCloseQuery – действие по умолчанию, устанавливает переменную CanClose в значание TRUE и продолжает закрытие формы.

2. FormClose

3. FormDestroy

Если приложение активно и вы пытаетесь завершить работу Windows (Shut Down), происходят следующие события (с соблюдением последовательности):

1. FormCloseQuery

2. FormDestroy

Мы видим, что метод FormClose в этом случае не вызывается.

Теперь воспроизведем всю последовательность событий, происходящую при попытке завершить работу Windows:

1. Windows посылает сообщение WM_QUERYENDSESSION всем приложениям и ожидает ответ.

2. Каждое приложение получает сообщение и возвращает одну из величин: не равную нулю – приложение готово завершить свою работу, 0 – приложение не может завершить свою работу.

3. Если одно из приложений возвращает 0, Windows не завершает свою работу, а снова рассылает всем окнам сообщение, на этот раз WM_ENDSESSION.

4. Каждое приложение должно снова подтвердить свою готовность завершить работу, поэтому операционная система ожидает ответа TRUE, резонно предполагая, что оставшиеся приложения с момента предыдущего сообщения закрыли свои сессии и готовы завершить работу. Теперь посмотрим, как на это реагирует Delphi-приложение: приложение возвращает значение TRUE и немедленно вызывает метод FormDestroy, игнорируя при этом метод FormClose. Налицо проблема.

5. Завершение работы Windows.

Первое решение проблемы: приложение Delphi на сообщение WM_QUERYENDSESSION должно возвратить 0, не дав при этом Windows завершить свою работу. При этом бессмысленно пытаться воспользоваться методом FormCloseQuery, поскольку нет возможности определить виновника завершения работы приложения (это может являться как результатом сообщения WM_QUERYENDSESSION, так и просто действием пользователя при попытке закрыть приложение).

Другое решение состоит в том, чтобы при получении сообщения WM_QUERYENDSESSION самим выполнить необходимые действия, вызвав метод FormClose.

unit Unit1;

interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs;

type TForm1 = class(TForm)

 procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

 {--------------------------------------------------------}

 { Объявляем свой обработчик сообщения WM_QUERYENDSESSION }

 {--------------------------------------------------------}

 procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;

public

 { Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.DFM}

{--------------------------------------------------------------}

{ Создаем процедуру обработки сообщения WM_QUERYENDSESSION.    }

{ Приложение получит только это сообщение при попытке Windows  }

{ завершить работу                                             }

{--------------------------------------------------------------}

procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);

begin

 inherited;   { сначала сообщание должен обработать наследуемый метод }

 {--------------------------------------------------------------------}

 { в этой точке вы также можете сообщить Windows о неготовности       }

 { приложения завершить работу…                                     }

 { Message.Result:=0;                                                 }

 {-------------------------------------------или----------------------}

 { вызов процедуры освобождения ресурсов, предусмотренной в FormClose }

 { MyCleanUpProcedure;                                                }

 {--------------------------------------------------------------------}

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 MyCleanUpProcedure;

end;

end.

Я не тестировал этот код, но могу предположить, что он должен работать. Сообщите, если это не так!

Каким образом запустить процесс завершения работы операционной системы (функция ExitWindows) из кода моей программы? Мне необходимо перезапустить операционную систему без перезапуска компьютера.

Ok, приводим обе функции для перезапуска операционной системы:

procedure TMainForm.RestartWindowsBtnClick(Sender: TObject);

begin

 if not ExitWindows(EW_RestartWindows, 0) then ShowMessage('Приложение не может завершить работу');

end;

procedure TMainForm.RebootSystemBtnClick(Sender: TObject);

begin

 if not ExitWindows(EW_RebootSystem, 0) then ShowMessage('Приложение не может завершить работу');

end;

Функция ExitWindows не была правильно задокументирована Microsoft'ом и не содержит описания возвращаемого значения. Более того, информация о этой функции практически не встречается в других источниках. Вот правильное определение этой функции:

function ExitWindows(dwReturnCode: Longint; Reserved: Word): Bool;

Выключить монитор:

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

Включить монитор:

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, –1);

Алгоритм, применяемый мною:

В блоке begin..end модуля .dpr:

begin

 if HPrevInst <>0 then begin

  ActivatePreviousInstance;

  Halt;

 end;

end;

Реализация в модуле:

unit PrevInst;

interface

uses WinProcs, WinTypes, SysUtils;

type

 PHWnd = ^HWnd;

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool; export;

procedure ActivatePreviousInstance;

implementation

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool;

var

 ClassName : array[0..30] of char;

begin

 Result := true;

 if GetWindowWord(Wnd, GWW_HINSTANCE) = HPrevInst then begin

  GetClassName(Wnd, ClassName, 30);

  if STRIComp(ClassName,'TApplication')=0 then begin

   TargetWindow^:= Wnd;

   Result := false;

  end;

 end;

end;

procedure ActivatePreviousInstance;

var

 PrevInstWnd: HWnd;

begin

 PrevInstWnd:= 0;

 EnumWindows(@EnumApps,LongInt(@PrevInstWnd));

 if PrevInstWnd <> 0 then if IsIconic(PrevInstWnd) then

  ShowWindow(PrevInstWnd,SW_Restore)

 else

  BringWindowToTop(PrevInstWnd);

end;

end.

Предоставленное разработчиками Delphi 2 Пачекой (Pacheco) и Тайхайрой (Teixeira) и значительно переработанное.

unit multinst;

{Применение:

 Необходимый код в исходном проекте

 if InitInstance then begin

  Application.Initialize;

  Application.CreateForm(TFrmSelProject, FrmSelProject);

  Application.Run;

 end;

 Это все понятно (я надеюсь)}

interface

uses Forms, Windows, Dialogs, SysUtils;

const

 MI_NO_ERROR = 0;

 MI_FAIL_SUBCLASS = 1;

 MI_FAIL_CREATE_MUTEX = 2;

{ Проверка правильности запуска приложения с помощью описанных ниже функций. }

{ Количество флагов ошибок MI_* может быть более одного. }

function GetMIError: Integer;

Function InitInstance : Boolean;

implementation

const

 UniqueAppStr : PChar;   {Различное для каждого приложения}

var

 MessageId: Integer;

 WProc: TFNWndProc = Nil;

 MutHandle: THandle = 0;

 MIError: Integer = 0;

function GetMIError: Integer;

begin

 Result:= MIError;

end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; StdCall;

begin

 { Если это – сообщение о регистрации… }

 if Msg = MessageID then begin

  { если основная форма минимизирована, восстанавливаем ее }

  { передаем фокус приложению }

  if IsIconic(Application.Handle) then begin

   Application.MainForm.WindowState:= wsNormal;

   ShowWindow(Application.Mainform.Handle, sw_restore);

  end;

  SetForegroundWindow(Application.MainForm.Handle);

 end

 { В противном случае посылаем сообщение предыдущему окну }

 else Result:= CallWindowProc(WProc, Handle, Msg, wParam, lParam);

end;

procedure SubClassApplication;

begin

 { Обязательная процедура. Необходима, чтобы обработчик }

 { Application.OnMessage был доступен для использования. }

 WProc:= TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));

 { Если происходит ошибка, устанавливаем подходящий флаг }

 if WProc = Nil then MIError:= MIError or MI_FAIL_SUBCLASS;

end;

procedure DoFirstInstance;

begin

 SubClassApplication;

 MutHandle:= CreateMutex(Nil, False, UniqueAppStr);

 if MutHandle = 0 then

  MIError:= MIError or MI_FAIL_CREATE_MUTEX;

end;

procedure BroadcastFocusMessage;

{ Процедура вызывается, если уже имеется запущенная копия Вашей программы. }

var

 BSMRecipients: DWORD;

begin

 { Не показываем основную форму }

 Application.ShowMainForm:= False;

 { Посылаем другому приложению сообщение и информируем о необходимости }

 { перевести фокус на себя }

 BSMRecipients:= BSM_APPLICATIONS;

 BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, MessageID, 0, 0);

end;

Function InitInstance : Boolean;

begin

 MutHandle:= OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);

 if MutHandle = 0 then begin

  { Объект Mutex еще не создан, означая, что еще не создано }

  { другое приложение. }

  ShowWindow(Application.Handle, SW_ShowNormal);

  Application.ShowMainForm:=True;

  DoFirstInstance;

  result:= True;

 end else begin

  BroadcastFocusMessage;

  result:= False;

 end;

end;

initialization

begin

 UniqueAppStr:= Application.Exexname;

 MessageID:= RegisterWindowMessage(UniqueAppStr);

 ShowWindow(Application.Handle, SW_Hide);

 Application.ShowMainForm:=FALSE;

end;

finalization

begin

 if WProc <> Nil then

  { Приводим приложение в исходное состояние }

  SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));

end;

end.

VAR MutexHandle:THandle;

Var UniqueKey: string;

FUNCTION IsNextInstance:BOOLEAN;

BEGIN

 Result:=FALSE;

 MutexHandle:=0;

 MutexHandle:=CREATEMUTEX(NIL,true, uniquekey);

 IF MutexHandle<>0 THEN BEGIN

  IF GetLastError=ERROR_ALREADY_EXISTS THEN BEGIN

   Result:=TRUE;

   CLOSEHANDLE(MutexHandle);

   MutexHandle:=0;

  END;

 END;

END;

begin

 CmdShow:=SW_HIDE;

 MessageId:=RegisterWindowMessage(zAppName);

 Application.Initialize;

 IF IsNextInstance THEN PostMessage(HWND_BROADCAST, MessageId,0,0)

 ELSE BEGIN

  Application.ShowMainForm:=FALSE;

  Application.CreateForm(TMainForm, MainForm);

  MainForm.StartTimer.Enabled:=TRUE;

  Application.Run;

 END;

 IF MutexHandle<>0 THEN CLOSEHANDLE(MutexHandle);

end.

В MainForm вам необходимо вставить обработчик внутреннего сообщения

PROCEDURE TMainForm.OnAppMessage(VAR M:TMSG; VAR Ret:BOOLEAN);

BEGIN

IF M.Message=MessageId THEN BEGIN

 Ret:=TRUE;

 // Поместить окно наверх !!!!!!!!

 END;

END;

INITIALIZATION

 ShowWindow(Application.Handle, SW_Hide);

END.

uses Wintypes,WinProcs,Toolhelp,Classes,Forms;

Function WinExecAndWait(Path: string; Visibility: word): word;

var

 InstanceID: THandle;

 PathLen: integer;

begin

 { Преобразуем строку в тип PChar }

 PathLen:= Length(Path);

 Move(Path[1],Path[0],PathLen);

 Path[PathLen]:= #00;

 { Пытаемся запустить приложение }

 InstanceID:= WinExec(@Path,Visibility);

 if InstanceID < 32 then { значение меньше 32 указывает на ошибку приложения }

  WinExecAndWait:= InstanceID

 else begin

  Repeat

   Application.ProcessMessages;

  until Application.Terminated or (GetModuleUsage(InstanceID) = 0);

  WinExecAndWait:= 32;

 end;

end;

function WinExecAndWait32(FileName: String; Visibility: integer):integer;

var

 zAppName:array[0..512] of char;

 zCurDir:array[0..255] of char;

 WorkDir:String;

 StartupInfo:TStartupInfo;

 ProcessInfo:TProcessInformation;

begin

 StrPCopy(zAppName,FileName);

 GetDir(0,WorkDir);

 StrPCopy(zCurDir,WorkDir);

 FillChar(StartupInfo,Sizeof(StartupInfo),#0);

 StartupInfo.cb:= Sizeof(StartupInfo);

 StartupInfo.dwFlags:= STARTF_USESHOWWINDOW;

 StartupInfo.wShowWindow:= Visibility;

 if not CreateProcess(nil,

  zAppName,                      { указатель командной строки }

  nil,                           { указатель на процесс атрибутов безопасности }

  nil,                           { указатель на поток атрибутов безопасности }

  false,                         { флаг родительского обработчика }

  CREATE_NEW_CONSOLE or          { флаг создания }

  NORMAL_PRIORITY_CLASS,

  nil,                           { указатель на новую среду процесса }

  nil,                           { указатель на имя текущей директории }

  StartupInfo,                   { указатель на STARTUPINFO }

  ProcessInfo) then result := –1 { указатель на process_inf }

 else begin

  WaitforSingleObject(ProcessInfo.hProcess,INFINITE);

  GetExitCodeProcess(ProcessInfo.hProcess,Result);

 end;

end;

Вот мое решение. Я использовал его во многих программах и смело рекомендую его вам.

procedure TForm1.Button1Click(Sender: TObject);

var

 szFileName: array[0..49] of char;

 szModuleName: array[0..19] of char;

 iSize : integer;

begin

 StrPCopy(szModuleName, 'NameOfModule');

 iSize:= GetModuleFileName(GetModuleHandle(szModuleName), szFileName, SizeOf(szFileName));

 if iSize > 0 then ShowMessage('Имя модуля с полным путем: ' + StrPas(szFileName))

 else ShowMessage('Имя модуля не встречено');

end;

Каким образом извлечь иконку из EXE– и DLL-файлов (ExtractAssociatedIcon) и отобразить ее на компоненте Timage или небольшой области на форме?

uses ShellApi;

procedure TForm1.Button1Click(Sender: TObject);

var

 IconIndex: word;

 h: hIcon;

begin

 IconIndex:= 0;

 h:= ExtractAssociatedIcon(hInstance, 'C:\WINDOWS\NOTEPAD.EXE', IconINdex);

 DrawIcon(Form1.Canvas.Handle, 10, 10, h);

end;