dws2mflibfuncs.pas

script language

  begin
    start := source;
    if Length(source) = 0 then
    begin
      SetLength(source, 1);
      source[1] := #0;
    end;
    if Length(wc) = 0 then
    begin
      SetLength(wc, 1);
      wc[1] := #0;
    end;
  end;

  if cf then
  begin
    Source := AnsiUpperCase(source);
    wc := AnsiUpperCase(wc);
  end;

  while (result <> '') and (wc[p] <> #0) and (source[s] <> #0) do
  begin
    case wc[p] of
      '?':
        begin
          if source[s] <> #0 then
          begin
            Inc(p);
            Inc(s);
            if afterstar > 0 then
              Dec(afterstar);
          end
          else
            result := '';
        end;
      '+':
        begin
          if source[s] <> #0 then
          begin
            Inc(p);
            Inc(s);
            Inc(afterstar);
          end
          else
            result := '';
        end;
      '*':
        begin
          Inc(p);
          Inc(afterstar);
        end;
      '[':
        begin
          if afterstar > 0 then
          begin
            if _brktcmp(Copy(wc, p, Length(wc)), source[s]) = False then
              result := '';
            while (source[s] <> #0) and (result <> '') do
            begin
              if _brktcmp(Copy(wc, p, Length(wc)), source[s]) = False then
                result := '';
              Inc(s);
            end;
            while IncWC(Copy(source, s, Length(source)), Copy(wc, p, Length(wc)),
              False, ebene) = '' do
            begin
              Inc(s);
              if source[s] = #0 then
              begin
                Dec(ebene);
                result := '';
                Exit;
              end;
            end;
            Dec(ebene);
            result := Source;
            Exit;
          end
          else
          begin
            if _brktcmp(Copy(wc, p, Length(wc)), source[s]) = False then
            begin
              if ebene > 0 then
              begin
                Dec(ebene);
                result := '';
                Exit;
              end
              else
              begin
                p := pat;
                start := Copy(start, 2, Length(source));
                s := Length(source) - Length(start) + 1;
                Break;
              end;
            end;
            Inc(s);
          end;

          while wc[p] <> ']' do
          begin
            if wc[p] = '\' then
              Inc(p);
            Inc(p);
          end;
          Inc(p);
        end;
    else
      if wc[p] = '\' then
        Inc(p);
      if afterstar > 0 then
      begin
        while (source[s] <> #0) and (wc[p] <> source[s]) do
          Inc(s);
        if source[s] = #0 then
          result := '';
        while IncWC(Copy(source, s, Length(source)), Copy(wc, p, Length(wc)),
          False, ebene) = '' do
        begin
          Inc(s);
          if source[s] = #0 then
          begin
            Dec(ebene);
            result := '';
            Exit;
          end;
        end;
        Dec(ebene);
        result := start;
        Exit;
      end
      else
      begin
        if wc[p] <> source[s] then
        begin
          if ebene > 0 then
          begin
            Dec(ebene);
            result := '';
            Exit;
          end
          else
          begin
            p := pat;
            start := Copy(start, 2, Length(source));
            s := Length(source) - Length(start) + 1;
          end;
        end
        else
        begin
          Inc(p);
          Inc(s);
        end;
      end;
    end;
  end;

  while (afterstar > 0) and (source[s] <> #0) do
    Inc(s);
  while wc[p] = '*' do
    Inc(p);
  if (result <> '') and (wc[p] <> #0) then
    result := '';

  Dec(ebene);

  if result <> '' then
  begin
    start := Copy(start, 1, Length(start) - (Length(source) - s + 1));
    result := start;
  end;
end;

function TestWC(wc: string): Integer;
var
  p: Integer;
begin
  p := 1;
  result := 0;

  while wc[p] <> #0 do
  begin
    case wc[p] of
      '\':
        begin
          Inc(p);
          if wc[p] = #0 then
          begin
            result := 1;
            Exit;
          end;
          Inc(p);
        end;
      '[':
        begin
          Inc(p);
          while (wc[p] <> #0) and (wc[p] <> ']') do
          begin
            if wc[p] = '\' then
              Inc(p, 2)
            else
              Inc(p);

            if wc[p] = '-' then
            begin
              Inc(p);
              if (wc[p] = #0) or (wc[p] = ']') then
              begin
                result := 2;
                Exit;
              end
              else if wc[p] = '\' then
                Inc(p);
              Inc(p);
            end;
          end;

          if wc[p] <> ']' then
          begin
            result := 3;
            Exit;
          end;
          Inc(p);
        end;
      '+',
        '*',
        '?':
        Inc(p);
    else
      Inc(p);
    end;
  end;
end;

function SearchWindow(var cName, wName: string; ProcID: DWord = 0): HWnd;
var
  WinRec: TWinRec;
begin
  WinRec.Handle := 0;
  WinRec.ProcID := ProcID;
  WinRec.Child := 0;
  WinRec.Num := 0;
  WinRec.ClassName := cName;
  WinRec.WindowName := wName;
  EnumWindows(@EnumWindowsProc, LPARAM(@WinRec));
  Result := WinRec.Handle;
  if WinRec.Handle > 0 then
  begin
    cName := WinRec.ClassName;
    wName := WinRec.WindowName;
  end;
end;

function SearchWindowEx(Parent, Child: HWnd; var cName, wName: string; Num: Integer
  = 0): HWnd;
var
  WinRec: TWinRec;
begin
  WinRec.Handle := 0;
  WinRec.ProcID := 0;
  WinRec.Child := Child;
  WinRec.Num := Num;
  WinRec.ClassName := cName;
  WinRec.WindowName := wName;
  EnumChildWindows(Parent, @EnumWindowsProc, LPARAM(@WinRec));
  Result := WinRec.Handle;
  if WinRec.Handle > 0 then
  begin
    cName := WinRec.ClassName;
    wName := WinRec.WindowName;
  end;
end;

function WaitForWindow(var cName, wName: string; Timeout: DWord; ProcID: DWord =
  0): HWnd;
var
  WinRec: TWinRec;
  Count: DWord;
begin
  WinRec.Handle := 0;
  WinRec.ProcID := ProcID;
  WinRec.Child := 0;
  WinRec.Num := 0;
  WinRec.ClassName := cName;
  WinRec.WindowName := wName;
  Count := GetTickCount;
  EnumWindows(@EnumWindowsProc, LPARAM(@WinRec));
  while WinRec.Handle = 0 do
  begin
    Sleep(100);
    if Timeout > 0 then
      if (GetTickCount - Count) > Timeout then
      begin
        Break;
      end;
    EnumWindows(@EnumWindowsProc, LPARAM(@WinRec));
  end;
  Result := WinRec.Handle;
  if WinRec.Handle > 0 then
  begin
    cName := WinRec.ClassName;
    wName := WinRec.WindowName;
  end;
end;

function WaitForWindowClose(var cName, wName: string; Timeout: DWord; ProcID: DWord
  = 0): Boolean;
var
  w: HWnd;
begin
  w := SearchWindow(cName, wName, ProcID);
  if w = 0 then
  begin
    Result := True;
    Exit;
  end;
  Result := WaitForWindowClose(w, Timeout);
end;

function WaitForWindowClose(w: HWnd; Timeout: DWord): Boolean;
var
  Count: DWord;
begin
  Count := GetTickCount;
  if w = 0 then
    w := GetForegroundWindow;
  Result := not IsWindow(w);
  while not Result do
  begin
    Sleep(100);
    if Timeout > 0 then
      if (GetTickCount - Count) > Timeout then
      begin
        Break;
      end;
    Result := not IsWindow(w);
  end;
end;

function WaitForWindowEnabled(var cName, wName: string; Timeout: DWord; ProcID:
  DWord = 0): Boolean;
var
  w: HWnd;
begin
  w := SearchWindow(cName, wName, ProcID);
  if w = 0 then
  begin
    Result := False;
    Exit;
  end;
  Result := WaitForWindowEnabled(w, Timeout);
end;

function WaitForWindowEnabled(w: HWnd; Timeout: DWord): Boolean;
var
  Ret: DWord;
begin
  if SendMessageTimeout(w, WM_USER, 0, 0, SMTO_NORMAL, Timeout, Ret) = 0 then
    Result := False
  else
    Result := True;
end;

function WaitForWindowEx(Parent: HWnd; var cName, wName: string; Timeout: DWord;
  Num: Integer = 0): HWnd;
var
  WinRec: TWinRec;
  Count: DWord;
begin
  WinRec.Handle := 0;
  WinRec.ProcID := 0;
  WinRec.Child := 0;
  WinRec.Num := Num;
  WinRec.ClassName := cName;
  WinRec.WindowName := wName;
  Count := GetTickCount;
  EnumChildWindows(Parent, @EnumWindowsProc, LPARAM(@WinRec));
  while WinRec.Handle = 0 do
  begin
    Sleep(100);
    if Timeout > 0 then
      if (GetTickCount - Count) > Timeout then
      begin
        Break;
      end;
    EnumChildWindows(Parent, @EnumWindowsProc, LPARAM(@WinRec));
  end;
  Result := WinRec.Handle;
  if WinRec.Handle > 0 then
  begin
    cName := WinRec.ClassName;
    wName := WinRec.WindowName;
  end;
end;

procedure WindowMove(w: HWnd; x, y: Integer; Abs: Boolean);
var
  Rect: TRect;
begin
  if IsWindow(w) then
  begin
    if GetWindowRect(w, Rect) then
    begin
      if abs then
      begin
        Rect.Left := x;
        Rect.Top := y;
      end
      else
      begin
        Inc(Rect.Left, x);
        Inc(Rect.Top, y);
      end;
      SetWindowPos(w, 0,
        Rect.Left, Rect.Top,
        0, 0,
        SWP_NOSIZE or SWP_NOZORDER);
    end;
  end;
end;

procedure WindowResize(w: HWnd; x, y: Integer; Abs: Boolean);
var
  Rect: TRect;
begin
  if IsWindow(w) then
  begin
    if GetWindowRect(w, Rect) then
    begin
      if abs then
      begin
        Rect.Right := x;
        Rect.Bottom := y;
      end
      else
      begin
        Inc(Rect.Right, x);
        Inc(Rect.Bottom, y);
        Rect.Right := Rect.Right - Rect.Left;
        Rect.Bottom := Rect.Bottom - Rect.Top;
      end;
      SetWindowPos(w, 0,
        0, 0,
        Rect.Right, Rect.Bottom,
        SWP_NOMOVE or SWP_NOZORDER);
    end;
  end;
end;

function SendKeysWin(w, s: string; wait: Integer = 0; back: Boolean = False):
  Integer;
var
  KeyWin: HWnd;
  c: string;
begin
  c := '';
  KeyWin := SearchWindow(c, w);
  if KeyWin = 0 then
  begin
    Result := SK_WindowNotFound;
    Exit;
  end;
  Result := SendKeysWin(KeyWin, s, wait, back);
end;

function SendKeysWin(w: HWnd; s: string; wait: Integer = 0; back: Boolean = False):
  Integer;
var
  OldWin: HWnd;
begin
  if Back then
    OldWin := GetForegroundWindow
  else
    OldWin := 0;
  if w <> 0 then
  begin
    if not IsWindow(w) then
    begin
      Result := SK_WindowNotFound;
      Exit;
    end;
    if IsIconic(w) then
      ShowWindow(w, SW_RESTORE);
    if not SetForegroundWindow(w) then
    begin
      Result := SK_WindowNotActive;
      Exit;
    end;
  end;
  Result := SK_None;
  SendKeys(s, wait);
  if (w <> 0) and
    (OldWin <> 0) and
    (OldWin <> w) then
    SetForegroundWindow(OldWin);
end;

procedure SendKeys(s: string; wait: Integer = 0);
var
  i: Integer;
  k: Integer;
  shift: Boolean;
  alt: Boolean;
  ctrl: Boolean;
  flag: Boolean;
  w: Word;
  hs: string;
  fw: HWnd;

  procedure SimulateKeyDown(Key: Byte);
  begin
    keybd_event(Key, 0, 0, 0);
  end;

  procedure SimulateKeyUp(Key: Byte);
  begin
    keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
  end;

  procedure SimulateKeystroke(Key: Byte; extra: DWORD);
  begin
    keybd_event(Key, extra, 0, 0);
    keybd_event(Key, extra, KEYEVENTF_KEYUP, 0);
  end;

  procedure SetOff;
  begin
    if alt then
    begin
      SimulateKeyUp(VK_MENU);
      alt := false;
    end;
    if ctrl then
    begin
      SimulateKeyUp(VK_CONTROL);
      ctrl := false;
    end;
    if shift then
    begin
      SimulateKeyUp(VK_SHIFT);
      shift := false;
    end;
  end;

  procedure SendSingleKey;
  var
    shift: Boolean;
  begin
    shift := HiByte(w) and 1 = 1;
    if shift then
      SimulateKeyDown(VK_SHIFT);
    case w of
      1617, // @
      1592, // [
      1755, // \
      1593, // ]
      1591, // {
      1762, // |
      1584, // }
      1723, // ~
      1586, //