RnQ/for.RnQ/RnQSysUtils.pas

{
  This file is part of R&Q.
  Under same license
}
unit RnQSysUtils;
{$I ForRnQConfig.inc}
{$I NoRTTI.inc}

interface

uses
  Winapi.Windows, System.SysUtils, Vcl.Forms, Vcl.Graphics;

function ConnectionAvailable: Boolean;
function getDefaultBrowser(const proto: string = 'http'): string;
procedure exec(const cmd: string; const pars: string = '');
function DSiExecute(const commandLine: string; visibility: integer = SW_SHOWDEFAULT; const workDir: string = ''; wait: boolean = false): cardinal;
procedure OpenURL(const pURL: String);

// Äëÿ òîãî, ÷òîáû óáðàòü ïðîãðàììó Delphi èç ñïèñêà äèñïåò÷åðà çàäà÷ ìîæíî âîñïîëüçîâàòüñÿ ñëåäóþùèì êîäîì:
// Not Found!!!!
// function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
// procedure HideFromProcess;

// function  getSpecialFolder(const what:string):string;
function getSpecialFolder(const what: integer): String;
function expandEnv(const env: String): String;
// function  getURLfromFav(fn:string):string;
function DesktopWorkArea(clHandle: THandle): TRect;
function MenuFadeEnabled: Boolean;
function TooltipFadeEnabled: Boolean;
function SelectionFadeEnabled: Boolean;
function ForceForegroundWindow(hwnd: THandle; doRestore: boolean = TRUE): boolean;

// function  getRegion(bmp:TGPBitmap):HRGN;
function getRegion(bmp: Tbitmap): HRGN;
function IsTopMost(Frm: TForm): Boolean;
function IsTopMostWindow(Wnd: HWND): Boolean;
function SetTopMost(Frm: TForm; Val: Boolean): Boolean;
function SetTopMostWindow(Wnd: HWND; Val: Boolean): Boolean;
function FormVisible(Frm: TForm): boolean;

{ Clipboard }

function DSiIsHtmlFormatOnClipboard: boolean;
function DSiGetHtmlFormatFromClipboard: string;
procedure DSiCopyHtmlFormatToClipboard(const sHtml: string; const sText: string = '');

function DSiAddApplicationToFirewallExceptionList(const entryName, applicationFullPath: string): boolean;

function validFilename(const s: string): string;
procedure addLinkToFavorites(const link: string);

function IsCanShowNotifications: boolean;

procedure ApplyTaskButton(Frm: TForm);
procedure SetICQLinksHandler(Enabled: Boolean);
procedure TrimWorkingSet;
function IsElevated: Boolean;

implementation

uses
  Winapi.WinInet, Winapi.ShlObj, Winapi.ShellAPI,
  System.StrUtils, System.Win.ComObj, System.Win.Registry,
{$IFDEF RNQ}
  RQlog,
{$ENDIF RNQ}
  RDUtils, RDGlobal, RnQGlobal, GlobalLib;

function ConnectionAvailable: Boolean;
var
  d: dword;
begin
  Result := InternetGetConnectedState(@d, 0);
end;

procedure TrimWorkingSet;
var
  MainHandle: THandle;
begin
  try
    MainHandle := OpenProcess(PROCESS_ALL_ACCESS, False, GetCurrentProcessID);
    SetProcessWorkingSetSize(MainHandle, High(SIZE_T), High(SIZE_T));
    CloseHandle(MainHandle);
  except end;
end;

function IsElevated: Boolean;
var
  hToken, hProcess: THandle;
  pTokenInformation: pointer;
  ReturnLength: DWord;
  TokenInformation: TTokenElevation;
begin
  Result := False;
  hProcess := GetCurrentProcess;
  try
    if OpenProcessToken(hProcess, TOKEN_QUERY, hToken) then
    try
      TokenInformation.TokenIsElevated := 0;
      pTokenInformation := @TokenInformation;
      GetTokenInformation(hToken, TokenElevation, pTokenInformation, sizeof(TokenInformation), ReturnLength);
      Result := (TokenInformation.TokenIsElevated > 0);
    finally
      CloseHandle(hToken);
    end;
  except
    Result := false;
  end;
end;

function getDefaultBrowser(const proto: string = 'http'): string;
var
  reg: TRegistry;
begin
  Result := '';
  reg := TRegistry.create;
  reg.RootKey := HKEY_CLASSES_ROOT;
  if reg.openKey(proto + '\shell\open\command', false) then
  begin
    Result := reg.readString('');
    reg.closeKey;
  end;
  reg.free;
end;

function DSiExecute(const commandLine: string; visibility: integer; const workDir: string; wait: boolean): cardinal;
var
  processInfo: TProcessInformation;
  startupInfo: TStartupInfo;
  useWorkDir: string;
begin
  if workDir = '' then
    GetDir(0, useWorkDir)
  else
    useWorkDir := workDir;
  FillChar(startupInfo, SizeOf(startupInfo), #0);
  startupInfo.cb := SizeOf(startupInfo);
  startupInfo.dwFlags := STARTF_USESHOWWINDOW;
  startupInfo.wShowWindow := visibility;
  if not CreateProcess(nil, PChar(commandLine), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
    PChar(useWorkDir), startupInfo, processInfo) then
    Result := MaxInt
  else
  begin
    if wait then
    begin
      WaitForSingleObject(processInfo.hProcess, INFINITE);
      GetExitCodeProcess(processInfo.hProcess, Result);
    end else
      Result := 0;
    CloseHandle(processInfo.hProcess);
    CloseHandle(processInfo.hThread);
  end;
end; { DSiExecute }

procedure exec(const cmd: string; const pars: string = '');
// var
// Dir3: IAsyncCall;
// s : String;
begin
  // Dir3 := AsyncCall(@shellexecute, [0, 'open', pchar(cmd), pchar(pars), NIL, SW_SHOWNORMAL]);
  // Dir3 := AsyncCallEx(@LoadFromURL2, prm);
  // while (AsyncMultiSync([Dir3], True, 10) < 0)or not Dir3.Finished do
  // Application.ProcessMessages;
  shellexecute(0, 'open', PChar(cmd), PChar(pars), NIL, SW_SHOWNORMAL);
  { if pars > '' then
    s := cmd + ' ' + pars
    else
    s := cmd;
    DSiExecute(s, SW_SHOWNORMAL);
  }
end;

procedure OpenURLdef(const url: String);
var
  // szTemp :CHAR[256];
  s: String;
begin
  // sprintf(szTemp, "url.dll,FileProtocolHandler %s", url);
  s := 'url.dll,FileProtocolHandler ' + url;
  shellexecute(0, NIL, 'rundll32.exe', PChar(s), NIL, SW_SHOWNORMAL);
end;

procedure OpenURL(const pURL: String);
var
  url, prg, par, proto: String;
  i: integer;
begin
  if pURL = '' then
    exit;
  i := pos('://', pURL);
  if i = 0 then
    proto := ''
  else
    proto := Copy(pURL, 1, i - 1);
  i := length(pURL);
  if pURL[i] = '?' then
    url := Copy(pURL, 1, i - 1)
  else
    url := pURL;
  if (proto = '') or (proto = 'http') then
  begin
    if UseDefaultBrowser or (length(BrowserCmdLine) = 0) then
    begin
      exec(url);
      exit;
    end;
    prg := BrowserCmdLine;
    par := '';
    // search the point where the filename ends (and then come parameters)
    i := ipos('.exe', prg);
    if i > 0 then
    begin
      inc(i, 4);
      if prg[i] = '"' then
        inc(i);
    end;
    if i < length(prg) then
    begin
      par := Copy(prg, i + 1, length(prg)) + ' ';
      delete(prg, i, length(prg));
    end;
    if pos('%1', par) = 0 then
      par := par + ' ' + url
    else
      par := AnsiReplaceStr(par, '%1', url);
    exec(prg, trim(par));
  end
  else
    exec(url);
end;

{
  procedure HideFromProcess;
  begin
  //   if not (csDesigning in ComponentState) then
  RegisterServiceProcess(GetCurrentProcessID, 1);
  end;
}

function getSpecialFolder(const what: integer): string;
var
  szPath: array [0 .. MAX_PATH] of Char;
begin
  if (SUCCEEDED(SHGetFolderPath(Application.MainFormHandle, what, 0, 0, @szPath[0]))) then
  begin
    Result := IncludeTrailingPathDelimiter(StrPas(PChar(@szPath[0])));
  end else
    Result := '';
end;

function expandEnv(const env: String): String;
var
  len: Integer;
begin
  len := ExpandEnvironmentStrings(PChar(env), PChar(Result), 0);
  if len > 0 then
  begin
    SetLength(Result, len - 1);
    ExpandEnvironmentStrings(PChar(env), PChar(Result), len);
    Result := Result.Trim;
  end else
    Result := env;
end;

function getCLMon(clHanlde: THandle): TMonitor;
var
  mon: TMonitor;
begin
  mon := Screen.MonitorFromWindow(clHanlde);
  if (mon = nil) and (Screen.MonitorCount > 0) then
    mon := Screen.Monitors[0];
  Result := mon;
end;

function DesktopWorkArea(clHandle: THandle): TRect;
var
  mon: TMonitor;
begin
  mon := getCLMon(clHandle);
  if (mon = nil) then
    SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0)
  else
    Result := mon.WorkareaRect;
end;

function MenuFadeEnabled: Boolean;
var
  Animated: BOOL;
  FadeIn: BOOL;
begin
  Animated := False;
  SystemParametersInfo(SPI_GETMENUANIMATION, 0, @Animated, 0);
  FadeIn := False;
  SystemParametersInfo(SPI_GETMENUFADE, 0, @FadeIn, 0);
  Result := Animated and FadeIn;
end;

function TooltipFadeEnabled: Boolean;
var
  Animated: BOOL;
  FadeInOut: BOOL;
begin
  Animated := False;
  SystemParametersInfo(SPI_GETTOOLTIPANIMATION, 0, @Animated, 0);
  FadeInOut := False;
  SystemParametersInfo(SPI_GETTOOLTIPFADE, 0, @FadeInOut, 0);
  Result := Animated and FadeInOut;
end;

function SelectionFadeEnabled: Boolean;
var
  FadeOut: BOOL;
begin
  FadeOut := False;
  SystemParametersInfo(SPI_GETSELECTIONFADE, 0, @FadeOut, 0);
  Result := FadeOut;
end;

function ForceForegroundWindow(HWND: THandle; DoRestore: Boolean = True): Boolean;
begin
  Result := False;
  if IsIconic(HWND) and IsWindowVisible(HWND) then
  if DoRestore then
    ShowWindow(hwnd, SW_RESTORE)
  else
    Exit;

  if GetForegroundWindow = HWND then
  begin
    Result := True;
    Exit;
  end;
  BringWindowToTop(HWND);
  SetForegroundWindow(HWND);
  Result := (GetForegroundWindow = HWND);
end;
{
  function getURLfromFav(fn:string):string;
  var
  f:TextFile;
  s:string;
  begin
  result:='';
  assignFile(f,fn);
  reset(f);
  while not eof(f) do
  begin
  readln(f,s);
  if s='[InternetShortcut]' then
  begin
  readln(f,s);
  result:=copy(s,5,length(s));
  break;
  end;
  end;
  closeFile(f);
  end; // getURLfromFav
}

// Unused
{
  function getProxyFromIE : Boolean;
  const
  keyName='Software\Microsoft\Windows\CurrentVersion\Internet Settings';
  var
  reg:Tregistry;
  prox : String;
  begin
  reg:=Tregistry.create;
  if reg.openKey(keyName, FALSE) then
  begin
  prox := reg.ReadString('ProxyServer');
  if prox > '' then
  Result := True;
  end;
  reg.Free;
  end;

  procedure GetProxyData(var ProxyEnabled: boolean; var ProxyServer: string; var ProxyPort: integer);
  var
  ProxyInfo: PInternetProxyInfo;
  Len: LongWord;
  i, j: integer;
  begin
  Len := 4096;
  ProxyEnabled := false;
  GetMem(ProxyInfo, Len);
  try
  if InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len)
  then
  if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then
  begin
  ProxyEnabled:= True;
  ProxyServer := ProxyInfo^.lpszProxy;
  showmessage('!');
  end
  finally
  FreeMem(ProxyInfo);
  end;

  if ProxyEnabled and (ProxyServer <> '') then
  begin
  i := Pos('http=', ProxyServer);
  if (i > 0) then
  begin
  Delete(ProxyServer, 1, i+5);
  j := Pos(';', ProxyServer);
  if (j > 0) then
  ProxyServer := Copy(ProxyServer, 1, j-1);
  end;
  i := Pos(':', ProxyServer);
  if (i > 0) then
  begin
  ProxyPort := StrToIntDef(Copy(ProxyServer, i+1, Length(ProxyServer)-i), 0);
  ProxyServer := Copy(ProxyServer, 1, i-1)
  end
  end;
  end;
}

{$WARN UNSAFE_CODE OFF}

function getRegion(bmp: Tbitmap): HRGN;
var
  span: HRGN;
  x, y, sx: integer;
  p: ^integer;
  transcolor: integer;

  procedure addspan;
  begin
    span := CreateRectRgn(sx, y, x, y + 1);
    CombineRgn(Result, Result, span, RGN_OR);
    DeleteObject(span);
    sx := -1;
  end;

begin
  if not bmp.Transparent then
  begin
    Result := 0;
    Exit;
  end;
  Result := CreateRectRgn(0, 0, 0, 0);
  if bmp = NIL then
    exit;
  with bmp do
  begin
    // pixelFormat:=pf32bit;
    transcolor := ABCD_ADCB(bmp.TransparentColor AND $FFFFFF);
    for y := 0 to height - 1 do
    begin
      p := bmp.scanline[y];
      sx := -1;
      for x := 0 to bmp.width - 1 do
      begin
        if (p^ <> transcolor) and (sx < 0) then
          sx := x;
        if (p^ = transcolor) and (sx >= 0) then
          addspan;
        inc(p);
      end;
      if sx >= 0 then
        addspan;
    end;
  end;
end;

function getRegion32(bmp: Tbitmap): HRGN;
var
  span: HRGN;
  x, y, sx: integer;
  p: ^integer;
  // transcolor:integer;

  procedure addspan;
  begin
    span := CreateRectRgn(sx, y, x, y + 1);
    CombineRgn(Result, Result, span, RGN_OR);
    DeleteObject(span);
    sx := -1;
  end;

begin
  if not bmp.Transparent then
  begin
    Result := 0;
    Exit;
  end;
  Result := CreateRectRgn(0, 0, 0, 0);
  if bmp = NIL then
    exit;
  with bmp do
  begin
    pixelFormat := pf32bit;
    // transcolor:=bmp.TransparentColor AND $FFFFFF;
    for y := 0 to height - 1 do
    begin
      p := bmp.scanline[y];
      sx := -1;
      for x := 0 to bmp.width - 1 do
      begin
        if (p^ and AlphaMask > 0) and (sx < 0) then
          sx := x;
        // if (p^ <> transcolor) and (sx < 0) then sx:=x;
        if (p^ and AlphaMask = 0) and (sx >= 0) then
          addspan;
        inc(p);
      end;
      if sx >= 0 then
        addspan;
    end;
  end;
end;
{$WARN UNSAFE_CODE ON}

function IsTopMost(Frm: TForm): Boolean;
begin
  Result := Assigned(Frm) and ((GetWindowLongPtr(Frm.Handle, GWL_EXSTYLE) and WS_EX_TOPMOST) > 0);
end;

function IsTopMostWindow(Wnd: HWND): Boolean;
begin
  Result := (Wnd > 0) and ((GetWindowLongPtr(Wnd, GWL_EXSTYLE) and WS_EX_TOPMOST) > 0);
end;

function SetTopMost(Frm: TForm; Val: Boolean): Boolean;
var
  i: integer;
begin
  if not Assigned(frm) then
    Result := false
  else
    with frm do
    begin
      i := GetWindowLongPtr(handle, GWL_EXSTYLE);
      if val then
      begin
        Result := SetWindowLongPtr(handle, GWL_EXSTYLE, i or WS_EX_TOPMOST) = i;
        SetWindowPos(handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE)
      end
        else
      begin
        Result := SetWindowLongPtr(handle, GWL_EXSTYLE, i and not WS_EX_TOPMOST) = i;
        SetWindowPos(handle, HWND_NOTOPMOST, Left, Top, Width, Height, SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE);
      end;
    end;
end;

function SetTopMostWindow(Wnd: HWND; Val: Boolean): Boolean;
var
  ExStyle: Integer;
begin
  ExStyle := GetWindowLongPtr(Wnd, GWL_EXSTYLE);
  if Val then
  begin
    Result := SetWindowLongPtr(Wnd, GWL_EXSTYLE, ExStyle or WS_EX_TOPMOST) = ExStyle;
    SetWindowPos(Wnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE);
  end
    else
  begin
    Result := SetWindowLongPtr(Wnd, GWL_EXSTYLE, ExStyle and not WS_EX_TOPMOST) = ExStyle;
    SetWindowPos(Wnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE);
  end;
end;

function FormVisible(Frm: TForm): boolean;
begin
  Result := (Frm <> nil) and IsWindowVisible(frm.handle)
end;

{ Clipboard }

var
  GCF_HTML: UINT;

  { :Checks if HTML format is stored on the clipboard.
    @since   2008-04-29
    @author  gabr
  }
function DSiIsHtmlFormatOnClipboard: boolean;
begin
  Result := IsClipboardFormatAvailable(GCF_HTML);
end; { DSiIsHtmlFormatOnClipboard }

{ :Retrieves HTML format from the clipboard. If there is no HTML format on the clipboard,
  function returns empty string.
  @since   2008-04-29
  @author  MP002, gabr
}
function DSiGetHtmlFormatFromClipboard: string;
var
  hClipData: THandle;
  idxEndFragment: integer;
  idxStartFragment: integer;
  pClipData: PChar;
begin
  Result := '';
  if DSiIsHtmlFormatOnClipboard then
  begin
    Win32Check(OpenClipboard(0));
    try
      hClipData := GetClipboardData(GCF_HTML);
      if hClipData <> 0 then
      begin
        pClipData := GlobalLock(hClipData);
        Win32Check(Assigned(pClipData));
        try
          idxStartFragment := pos('', pClipData); // len = 20
          idxEndFragment := pos('', pClipData);
          if (idxStartFragment >= 0) and (idxEndFragment >= idxStartFragment) then
            Result := Copy(pClipData, idxStartFragment + 20, idxEndFragment - idxStartFragment - 20);
        finally
          GlobalUnlock(hClipData);
        end;
      end;
    finally
      Win32Check(CloseClipboard);
    end;
  end;
end; { DSiGetHtmlFormatFromClipboard }

{ :Copies HTML (and, optionally, text) format to the clipboard.
  @since   2008-04-29
  @author  MP002, gabr
}
procedure DSiCopyHtmlFormatToClipboard(const sHtml, sText: string);

  function MakeFragment(const sHtml: string): string;
  const
    CVersion = 'Version:1.0'#13#10;
    CStartHTML = 'StartHTML:';
    CEndHTML = 'EndHTML:';
    CStartFragment = 'StartFragment:';
    CEndFragment = 'EndFragment:';
    CHTMLIntro = 'HTML clipboard';
    CHTMLExtro = '';
    CNumberLengthAndCR = 10;
    CDescriptionLength = // Let the compiler determine the description length.
      length(CVersion) + length(CStartHTML) + length(CEndHTML) + length(CStartFragment) + length(CEndFragment) + 4 *
      CNumberLengthAndCR;
  var
    description: string;
    idxEndFragment: integer;
    idxEndHtml: integer;
    idxStartFragment: integer;
    idxStartHtml: integer;
  begin
    // The sHtml clipboard format is defined by using byte positions in the entire block
    // where sHtml text and fragments start and end. These positions are written in a
    // description. Unfortunately the positions depend on the length of the description
    // but the description may change with varying positions. To solve this dilemma the
    // offsets are converted into fixed length strings which makes it possible to know
    // the description length in advance.
    idxStartHtml := CDescriptionLength; // position 0 after the description
    idxStartFragment := idxStartHtml + length(CHTMLIntro);
    idxEndFragment := idxStartFragment + length(sHtml);
    idxEndHtml := idxEndFragment + length(CHTMLExtro);
    description := CVersion + Format('%s%.8d', [CStartHTML, idxStartHtml]) + #13#10 +
      Format('%s%.8d', [CEndHTML, idxEndHtml]) + #13#10 + Format('%s%.8d', [CStartFragment, idxStartFragment]) +
      #13#10 + Format('%s%.8d', [CEndFragment, idxEndFragment]) + #13#10;
    Result := description + CHTMLIntro + sHtml + CHTMLExtro;
  end; { MakeFragment }

var
  clipFormats: array [0 .. 1] of UINT;
  clipStrings: array [0 .. 1] of string;
  hClipData: HGLOBAL;
  iFormats: integer;
  pClipData: PChar;

begin { DSiCopyHtmlFormatToClipboard }
  Win32Check(OpenClipboard(0));
  try
    // most descriptive first as per api docs
    clipStrings[0] := MakeFragment(sHtml);
    if sText = '' then
      clipStrings[1] := sHtml
    else
      clipStrings[1] := sText;
    clipFormats[0] := GCF_HTML;
    clipFormats[1] := CF_TEXT;
    Win32Check(EmptyClipBoard);
    for iFormats := 0 to High(clipStrings) do
    begin
      if clipStrings[iFormats] = '' then
        continue;
      hClipData := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, length(clipStrings[iFormats]) + 1);
      Win32Check(hClipData <> 0);
      try
        pClipData := GlobalLock(hClipData);
        Win32Check(Assigned(pClipData));
        try
          Move(PChar(clipStrings[iFormats])^, pClipData^, length(clipStrings[iFormats]) + 1);
        finally
          GlobalUnlock(hClipData);
        end;
        Win32Check(SetClipboardData(clipFormats[iFormats], hClipData) <> 0);
        hClipData := 0;
      finally
        if hClipData <> 0 then
          GlobalFree(hClipData);
      end;
    end;
  finally
    Win32Check(CloseClipboard);
  end;
end; { DSiCopyHtmlFormatToClipboard }

{ :Adds application to the list of firewall exceptions. Based on the code at
  http://www.delphi3000.com/articles/article_5021.asp?SK=.
  CoInitialize must be called before using this function.
  @author  gabr
  @since   2009-02-05
}
const // firewall management constants
  NET_FW_PROFILE_DOMAIN = 0;
  NET_FW_PROFILE_STANDARD = 1;
  NET_FW_IP_VERSION_ANY = 2;
  NET_FW_IP_PROTOCOL_UDP = 17;
  NET_FW_IP_PROTOCOL_TCP = 6;
  NET_FW_SCOPE_ALL = 0;
  NET_FW_SCOPE_LOCAL_SUBNET = 1;

function DSiAddApplicationToFirewallExceptionList(const entryName, applicationFullPath: string): boolean;
var
  app: OleVariant;
  fwMgr: OleVariant;
  profile: OleVariant;
begin
  Result := False;
  try
    fwMgr := CreateOLEObject('HNetCfg.FwMgr');
    profile := fwMgr.LocalPolicy.CurrentProfile;
    app := CreateOLEObject('HNetCfg.FwAuthorizedApplication');
    app.ProcessImageFileName := applicationFullPath;
    app.Name := entryName;
    app.Scope := NET_FW_SCOPE_ALL;
    app.IpVersion := NET_FW_IP_VERSION_ANY;
    app.Enabled := TRUE;
    profile.AuthorizedApplications.Add(app);
    Result := True;
  except
    on E: EOleSysError do
      SetLastError(cardinal(E.ErrorCode));
  end;
end; { DSiAddApplicationToFirewallExceptionList }

type
  ELoadLibraryError = class(EOSError);
  EGetProcAddressError = class(EOSError);

function DelayedFailureHook(dliNotify: dliNotification; pdli: PDelayLoadInfo): Pointer; stdcall;
var
  s: String;
begin
  Result := nil;
  case dliNotify of
    dliNoteStartProcessing:
      ;
    dliNotePreLoadLibrary:
      ;
    dliNotePreGetProcAddress:
      ;
    dliFailLoadLibrary:
      begin
        s := Format('Failed to load library "%0:s".'#13#10' Error (%1:d) %2:s', [AnsiString(pdli.szDll), pdli.dwLastError,
          SysErrorMessage(pdli.dwLastError)]);
        RQlog.LogEvent(s, PIC_ASTERISK);
        raise EAbort.create(s);
        // raise ELoadLibraryError.CreateFmt(
        // 'Failed to load library "%0:s".'#13#10' Error (%1:d) %2:s',[AnsiString(pdli.szDll),
        // pdli.dwLastError, SysErrorMessage(pdli.dwLastError)]);
      end;
    dliFailGetProcAddress:
      if pdli.dlp.fImportByName then
      begin
        s := Format('Failed to load function "%0:s" from "%1:s"'#13#10' Error (%2:d) %3:s',
          [AnsiString(pdli.dlp.szProcName), AnsiString(pdli.szDll), pdli.dwLastError, SysErrorMessage(pdli.dwLastError)]);
        RQlog.LogEvent(s, PIC_ASTERISK);
        raise EAbort.create(s);
        // raise EGetProcAddressError.CreateFmt(
        // 'Failed to load function "%0:s" from "%1:s"'#13#10' Error (%2:d) %3:s',[
        // AnsiString(pdli.dlp.szProcName), AnsiString(pdli.szDll),
        // pdli.dwLastError, SysErrorMessage(pdli.dwLastError)])
      end
      else
      begin
        s := Format('Failed to load function #%0:d from "%1:s"'#13#10' Error (%2:d) %3:s',
          [pdli.dlp.dwOrdinal, AnsiString(pdli.szDll), pdli.dwLastError, SysErrorMessage(pdli.dwLastError)]);
        RQlog.LogEvent(s, PIC_ASTERISK);
        raise EAbort.create(s);
        // raise EGetProcAddressError.CreateFmt(
        // 'Failed to load function #%0:d from "%1:s"'#13#10' Error (%2:d) %3:s',[
        // pdli.dlp.dwOrdinal, AnsiString(pdli.szDll),
        // pdli.dwLastError, SysErrorMessage(pdli.dwLastError)]);
      end;

    dliNoteEndProcessing:
      ;
  end;
end;

function CheckAutorun(const pKey: String): boolean;
// pKey = 'R&Q_' + lastUser
var
  Registry: TRegistry;
begin
  Registry := TRegistry.create(KEY_READ);
  Result := False;
  try
    Registry.openKey('Software\Microsoft\Windows\CurrentVersion\Run', false);
    if (Registry.readString(pKey) <> '') then
      Result := True
  finally
    Registry.free;
  end;
end;

procedure SetAutorun(_on_: boolean; const pKey: String);
// pKey = 'R&Q_' + lastUser
var
  Registry: TRegistry;
  FName: string;
  F: TSearchRec;
begin
  Registry := TRegistry.create();
  try
    Registry.openKey('Software\Microsoft\Windows\CurrentVersion\Run', false);
    if _on_ then
    begin
      FName := myPath + 'R&Q.exe';
      if FindFirst(FName, 0, F) <> 0 then
        FName := myPath + 'R&Q.exe';
      Registry.WriteString(pKey, FName);
    end
    else
      Registry.DeleteValue(pKey);
  finally
    Registry.free;
  end;

end;

procedure SetICQLinksHandler(Enabled: Boolean);
var
  Reg: TRegistry;
begin
  if not IsElevated then
    Exit;
  Reg := TRegistry.Create;
  try
    if Enabled then
    begin
      Reg.RootKey := HKEY_CLASSES_ROOT;
      Reg.OpenKey('ICQLink', True);
      Reg.WriteString('', 'URL:ICQ Link');
      Reg.WriteString('URL Protocol', '');
      Reg.WriteInteger('EditFlags', 2);
      Reg.CloseKey;
      Reg.OpenKey('ICQLink\DefaultIcon', True);
      Reg.WriteString('', Application.ExeName + ',1');
      Reg.CloseKey;
      Reg.OpenKey('ICQLink\shell\open\command', True);
      Reg.WriteString('', '"' + Application.ExeName + '" --icqlink "%1"');
      Reg.CloseKey;

      Reg.OpenKey('Applications\' + ExtractFileName(Application.ExeName), True);
      Reg.WriteString('FriendlyAppName', 'R&Q ICQ Client');
      Reg.CloseKey;

      Reg.RootKey := HKEY_LOCAL_MACHINE;
      Reg.OpenKey('Software\R&Q', True);
      Reg.WriteString('', 'R&Q');
      Reg.CloseKey;
      Reg.OpenKey('Software\R&Q\Capabilities', True);
      Reg.WriteString('ApplicationDescription', 'R&Q ICQ URL');
      Reg.WriteString('ApplicationName', 'R&Q');
      Reg.CloseKey;
      Reg.OpenKey('Software\R&Q\Capabilities\URLAssociations', True);
      Reg.WriteString('icq', 'ICQLink');
      Reg.CloseKey;
//      Reg.OpenKey('Software\R&Q\shell\open\command', True);
//      Reg.WriteString('', '"' + Application.ExeName + '" --icqlink "%1"');
//      Reg.CloseKey;

      Reg.OpenKey('Software\RegisteredApplications', False);
      Reg.WriteString('R&Q', 'Software\R&Q\Capabilities');
      Reg.CloseKey;
    end
      else
    begin
      Reg.RootKey := HKEY_CLASSES_ROOT;
      Reg.DeleteKey('ICQLink');
      Reg.DeleteKey('Applications\' + ExtractFileName(Application.ExeName));
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      Reg.DeleteKey('Software\R&Q\Capabilities');
      Reg.OpenKey('Software\RegisteredApplications', False);
      Reg.DeleteValue('R&Q');
      Reg.CloseKey;
    end;
  finally
    Reg.free;
  end;
end;

function validFilename(const s: string): string;
const
  invalid = '\/:*?"<>|';
var
  i: integer;
begin
  Result := s;
  i := Length(Result);
  while i > 0 do
  begin
    if pos(Result[i], invalid) > 0 then
      delete(Result, i, 1);
    dec(i);
  end;
end;

procedure addLinkToFavorites(const link: string);
var
  s: string;
  F: textFile;
begin
  // s:=getSpecialFolder('Favorites')+ PathDelim +getTranslation('from R&Q');
  // s:=getSpecialFolder('Favorites')+ PathDelim + 'R&Q';
  s := getSpecialFolder(CSIDL_FAVORITES) + PathDelim + 'R&Q';
  ForceDirectories(s);
  IOResult;
  assignFile(F, IncludeTrailingPathDelimiter(s) + validFilename(link) + '.url');
  rewrite(F);
  writeln(F, '[InternetShortcut]');
  writeln(F, 'URL=' + link);
  closeFile(F);
end;

function IsCanShowNotifications: boolean;
var
  MachState: integer;
begin
  Result := True;
  try
    if CheckWin32Version(6, 0) then
      if (SUCCEEDED(SHQueryUserNotificationState(MachState))) then
        Result := MachState <> QUNS_RUNNING_D3D_FULL_SCREEN
  except

  end;
end;

{
  const
  CTK_ICON = 1;

  function mostRecentFileFrom(path:string):integer;
  var
  sr:TsearchRec;
  t:integer;
  begin
  result:=0;
  path:=IncludeTrailingPathDelimiter(path);
  if FindFirst(path+'*.*', faAnyFile, sr)=0 then
  repeat
  if sr.time > result then result:=sr.time;
  if (sr.name[1]<>'.') and (sr.Attr and faDirectory >0) then
  begin
  t:=mostRecentFileFrom(path+sr.name+ PathDelim);
  if t > result then result:=t;
  exit;
  end;
  until FindNext(sr) > 0;
  findClose(sr);
  end; // mostRecentFileFrom
}

procedure ApplyTaskButton(Frm: TForm);
begin
  SetWindowLongPtr(Frm.handle, GWLP_HWNDPARENT, 0);
  SetWindowLongPtr(Frm.handle, GWL_EXSTYLE, GetWindowLongPtr(Frm.handle, GWL_EXSTYLE) or WS_EX_APPWINDOW);
end;

(*
  initialization
  if debugHook = 0 then
  {$IFDEF COMPILER_16}
  SetDliFailureHook2(DelayedFailureHook);
  {$ELSE ~COMPILER_16}
  SetDliFailureHook(DelayedFailureHook);
  {$ENDIF COMPILER_16}
*)
end.