1 files changed, 725 insertions, 0 deletions
diff --git a/plugins/Utils.pas/syswin.pas b/plugins/Utils.pas/syswin.pas
new file mode 100644
index 0000000000..7cc646184a
--- /dev/null
+++ b/plugins/Utils.pas/syswin.pas
@@ -0,0 +1,725 @@
+unit syswin;
+{$include compilers.inc}
+
+interface
+
+uses windows;
+
+type
+  tFFWFilterProc = function(fname:pWideChar):boolean;
+
+const
+  ThreadTimeout = 50;
+const
+  gffdMultiThread = 1;
+  gffdOld         = 2;
+
+function GetWorkOfflineStatus:integer;
+
+function SendString(wnd:HWND;astr:PWideChar):integer; overload;
+function SendString(wnd:HWND;astr:PAnsiChar):integer; overload;
+procedure ProcessMessages;
+function GetFocusedChild(wnd:HWND):HWND;
+function GetAssoc(key:PAnsiChar):PAnsiChar;
+function GetFileFromWnd(wnd:HWND;Filter:tFFWFilterProc;
+         flags:dword=gffdMultiThread+gffdOld;timeout:cardinal=ThreadTimeout):pWideChar;
+
+function WaitFocusedWndChild(Wnd:HWnd):HWnd;
+
+function ExecuteWaitW(AppPath:pWideChar; CmdLine:pWideChar=nil; DfltDirectory:PWideChar=nil;
+         Show:DWORD=SW_SHOWNORMAL; TimeOut:DWORD=0; ProcID:PDWORD=nil):dword;
+function ExecuteWait(AppPath:PAnsiChar; CmdLine:PAnsiChar=nil; DfltDirectory:PAnsiChar=nil;
+         Show:DWORD=SW_SHOWNORMAL; TimeOut:DWORD=0; ProcID:PDWORD=nil):dword;
+
+function GetEXEbyWnd(w:HWND; var dst:pWideChar):pWideChar; overload;
+function GetEXEbyWnd(w:HWND; var dst:PAnsiChar):PAnsiChar; overload;
+function IsExeRunning(exename:PWideChar):boolean; {hwnd}
+
+implementation
+
+uses
+  {$IFNDEF FPC}shellapi,{$ENDIF}
+{$IFDEF COMPILER_16_UP}
+  WinAPI.PsApi,
+{$ELSE}
+  psapi,
+{$ENDIF}
+  common,messages;
+
+{$IFDEF COMPILER_16_UP}
+type  pqword = ^int64;
+{$ENDIF}
+
+function ExecuteWaitW(AppPath:pWideChar; CmdLine:pWideChar=nil; DfltDirectory:PWideChar=nil;
+         Show:DWORD=SW_SHOWNORMAL; TimeOut:DWORD=0; ProcID:PDWORD=nil):dword;
+var
+  Flags: DWORD;
+  {$IFDEF FPC}
+  Startup: StartupInfo;
+  {$ELSE}
+  Startup: StartupInfoW;
+  {$ENDIF}
+  ProcInf: TProcessInformation;
+  App: array [0..1023] of widechar;
+  p:PWideChar;
+  ext1,ext2:array [0..7] of widechar;
+begin
+  Result := cardinal(-1);
+  if FindExecutableW(AppPath,DfltDirectory,App)<=32 then
+    exit;
+  if lstrcmpiw(GetExt(AppPath,ext1,7),GetExt(App,ext2,7))<>0 then
+    CmdLine:=AppPath;
+  Flags := CREATE_NEW_CONSOLE;
+  if Show = SW_HIDE then
+    Flags := Flags or CREATE_NO_WINDOW;
+  FillChar(Startup, SizeOf(Startup),0);
+  with Startup do
+  begin
+    cb         :=SizeOf(Startup);
+    wShowWindow:=Show;
+    dwFlags    :=STARTF_USESHOWWINDOW;
+  end;
+  if ProcID <> nil then
+    ProcID^ := 0;
+  p:=StrEndW(App);
+  if (CmdLine<>nil) and (CmdLine^<>#0) then
+  begin
+    p^:=' ';
+    inc(p);
+    StrCopyW(p,CmdLine);
+  end;
+  if CreateProcessW(nil,App,nil,nil,FALSE,Flags,nil,DfltDirectory,Startup,ProcInf) then
+  begin
+    if TimeOut<>0 then
+    begin
+      if WaitForSingleObject(ProcInf.hProcess,TimeOut)=WAIT_OBJECT_0 then
+      begin
+        GetExitCodeProcess(ProcInf.hProcess,result);
+        CloseHandle(ProcInf.hProcess);
+      end
+      else
+      begin
+        result:=1;
+        if ProcID<>nil then
+          ProcID^:=ProcInf.hProcess;
+      end;
+    end
+    else
+    begin
+      GetExitCodeProcess(ProcInf.hProcess,result);
+      CloseHandle(ProcInf.hProcess);
+    end;
+    CloseHandle(ProcInf.hThread);
+  end;
+end;
+
+function ExecuteWait(AppPath:PAnsiChar; CmdLine:PAnsiChar=nil; DfltDirectory:PAnsiChar=nil;
+         Show:DWORD=SW_SHOWNORMAL; TimeOut:DWORD=0; ProcID:PDWORD=nil):dword;
+var
+  Flags: DWORD;
+  {$IFDEF FPC}
+  Startup: StartupInfo;
+  {$ELSE}
+  Startup: StartupInfoA;
+  {$ENDIF}
+  ProcInf: TProcessInformation;
+  App: array [0..1023] of AnsiChar;
+  p:PAnsiChar;
+  ext1,ext2:array [0..7] of AnsiChar;
+begin
+  Result := cardinal(-1);
+  if FindExecutableA(AppPath,DfltDirectory,App)<=32 then
+    exit;
+  if lstrcmpia(GetExt(AppPath,ext1,7),GetExt(App,ext2,7))<>0 then
+    CmdLine:=AppPath;
+  Flags := CREATE_NEW_CONSOLE;
+  if Show = SW_HIDE then
+    Flags := Flags or CREATE_NO_WINDOW;
+  FillChar(Startup, SizeOf(Startup),0);
+  with Startup do
+  begin
+    cb         :=SizeOf(Startup);
+    wShowWindow:=Show;
+    dwFlags    :=STARTF_USESHOWWINDOW;
+  end;
+  if ProcID <> nil then
+    ProcID^ := 0;
+  p:=StrEnd(App);
+  if (CmdLine<>nil) and (CmdLine^<>#0) then
+  begin
+    p^:=' ';
+    inc(p);
+    StrCopy(p,CmdLine);
+  end;
+  if CreateProcessA(nil,App,nil,nil,FALSE,Flags,nil,DfltDirectory,Startup,ProcInf) then
+  begin
+    if TimeOut<>0 then
+    begin
+      if WaitForSingleObject(ProcInf.hProcess,TimeOut)=WAIT_OBJECT_0 then
+      begin
+        GetExitCodeProcess(ProcInf.hProcess,result);
+        CloseHandle(ProcInf.hProcess);
+      end
+      else
+      begin
+        result:=1;
+        if ProcID<>nil then
+          ProcID^:=ProcInf.hProcess;
+      end;
+    end
+    else
+    begin
+      GetExitCodeProcess(ProcInf.hProcess,result);
+      CloseHandle(ProcInf.hProcess);
+    end;
+    CloseHandle(ProcInf.hThread);
+  end;
+end;
+
+//----- Information functions -----
+
+function GetWorkOfflineStatus:integer;
+var
+  lKey:HKEY;
+  len,typ:dword;
+begin
+  result:=0;
+  if RegOpenKeyEx(HKEY_CURRENT_USER,
+    'Software\Microsoft\Windows\CurrentVersion\Internet Settings',0,
+     KEY_READ,lKey)=ERROR_SUCCESS then
+  begin
+    len:=4;
+    typ:=REG_DWORD;
+    if RegQueryValueEx(lKey,'GlobalUserOffline',NIL,@typ,@result,@len)=ERROR_SUCCESS then
+    ;
+    RegCloseKey(lKey);
+  end;
+end;
+
+function GetAssoc(key:PAnsiChar):PAnsiChar;
+var
+  lKey:HKEY;
+  tmpbuf:array [0..511] of AnsiChar;
+  len:integer;
+begin
+  result:=nil;
+  if RegOpenKeyExA(HKEY_CLASSES_ROOT,key,0,
+     KEY_READ,lKey)=ERROR_SUCCESS then
+  begin
+    len:=511;
+    if (RegQueryValueExA(lKey,NIL,NIL,NIL,@tmpbuf,@len)=ERROR_SUCCESS) then
+    begin
+      StrDup(result,tmpbuf);
+//      only path
+//      while result[len]<>'\' do dec(len);
+//      StrCopy(result,result+2,len-3);
+    end;
+    RegCloseKey(lKey);
+  end;
+end;
+
+function GetFocusedChild(wnd:HWND):HWND;
+var
+  dwTargetOwner:DWORD;
+  dwThreadID:DWORD;
+  res:boolean;
+begin
+  dwTargetOwner:=GetWindowThreadProcessId(wnd,nil);
+  dwThreadID:=GetCurrentThreadId();
+  res:=false;
+  if (dwTargetOwner<>dwThreadID) then
+    res:=AttachThreadInput(dwThreadID,dwTargetOwner,TRUE);
+  result:=GetFocus;
+  if res then
+    AttachThreadInput(dwThreadID,dwTargetOwner,FALSE);
+end;
+
+function WaitFocusedWndChild(Wnd:HWnd):HWnd;
+var
+  T1,T2:Integer;
+  W:HWnd;
+begin
+  Sleep(50);
+  T1:=GetTickCount;
+  repeat
+    W:=GetTopWindow(Wnd);
+    if W=0 then W:=Wnd;
+    W:=GetFocusedChild(W);
+    if W<>0 then
+    begin
+      Wnd:=W;
+      break;
+    end;
+    T2:=GetTickCount;
+    if Abs(T1-T2)>100 then break;
+  until false;
+  Result:=Wnd;
+end;
+
+function SendString(wnd:HWND;astr:PWideChar):integer;
+var
+  s,s0:PWideChar;
+  style:integer;
+begin
+  result:=0;
+  if (astr=nil) or (astr^=#0) then exit;
+  if wnd=0 then
+  begin
+    wnd:=WaitFocusedWndChild(GetForegroundWindow);
+    if wnd=0 then Exit;
+  end;
+  style:=GetWindowLongW(wnd,GWL_STYLE);
+  if (style and (WS_DISABLED or ES_READONLY))=0 then
+  begin
+    StrDupW(s,astr); //??
+    s0:=s;
+    while s^<>#0 do
+    begin
+      if s^<>#10 then
+        PostMessageW(wnd,WM_CHAR,ord(s^),1);
+      Inc(s);
+    end;
+    mFreeMem(s0); //??
+    result:=1;
+  end;
+end;
+
+function SendString(wnd:HWND;astr:PAnsiChar):integer;
+var
+  s,s0:PAnsiChar;
+  style:integer;
+begin
+  result:=0;
+  if (astr=nil) or (astr^=#0) then exit;
+  if wnd=0 then
+  begin
+    wnd:=WaitFocusedWndChild(GetForegroundWindow);
+    if wnd=0 then Exit;
+  end;
+  style:=GetWindowLongA(wnd,GWL_STYLE);
+  if (style and (WS_DISABLED or ES_READONLY))=0 then
+  begin
+    StrDup(s,astr); //??
+    s0:=s;
+    while s^<>#0 do
+    begin
+      if s^<>#10 then
+        PostMessageA(wnd,WM_CHAR,ord(s^),1);
+      Inc(s);
+    end;
+    mFreeMem(s0); //??
+    result:=1;
+  end;
+end;
+
+procedure ProcessMessages;
+var
+  Unicode: Boolean;
+  MsgExists: Boolean;
+  Msg:tMsg;
+begin
+  repeat
+    if PeekMessageA(Msg,0,0,0,PM_NOREMOVE) then
+    begin
+      Unicode:=(Msg.hwnd<>0) and IsWindowUnicode(Msg.hwnd);
+      if Unicode then
+        MsgExists:=PeekMessageW(Msg,0,0,0,PM_REMOVE)
+      else
+        MsgExists:=PeekMessageA(Msg,0,0,0,PM_REMOVE);
+      if not MsgExists then break;
+
+      if Msg.Message<>WM_QUIT then
+      begin
+        TranslateMessage({$IFDEF FPC}@{$ENDIF}Msg);
+        if Unicode then
+          DispatchMessageW({$IFDEF FPC}@{$ENDIF}Msg)
+        else
+          DispatchMessageA({$IFDEF FPC}@{$ENDIF}Msg);
+      end;
+    end
+    else
+      break;
+  until false;
+end;
+
+//----- work with EXE -----
+
+function GetEXEbyWnd(w:HWND; var dst:pWideChar):pWideChar;
+var
+  hProcess:THANDLE;
+  ProcID:DWORD;
+  ModuleName: array [0..300] of WideChar;
+begin
+  dst:=nil;
+  GetWindowThreadProcessId(w,@ProcID);
+  if ProcID<>0 then
+  begin
+    hProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,ProcID);
+    if hProcess<>0 then
+    begin
+      ModuleName[0]:=#0;
+      GetModuleFilenameExW(hProcess,0,ModuleName,SizeOf(ModuleName));
+      StrDupW(dst,ModuleName);
+      CloseHandle(hProcess);
+    end;
+  end;
+  result:=dst;
+end;
+
+function GetEXEbyWnd(w:HWND; var dst:PAnsiChar):PAnsiChar;
+var
+  hProcess:THANDLE;
+  ProcID:DWORD;
+  ModuleName: array [0..300] of AnsiChar;
+begin
+  dst:=nil;
+  GetWindowThreadProcessId(w,@ProcID);
+  if ProcID<>0 then
+  begin
+    hProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,ProcID);
+    if hProcess<>0 then
+    begin
+      ModuleName[0]:=#0;
+      GetModuleFilenameExA(hProcess,0,ModuleName,SizeOf(ModuleName));
+      StrDup(dst,ModuleName);
+      CloseHandle(hProcess);
+    end;
+  end;
+  result:=dst;
+end;
+
+function IsExeRunning(exename:PWideChar):boolean;{hwnd}
+const
+  nCount = 4096;
+var
+  Processes:array [0..nCount-1] of dword;
+  nProcess:dword;
+  hProcess:THANDLE;
+  ModuleName: array [0..300] of WideChar;
+  i:integer;
+begin
+  result:=false;
+  EnumProcesses(pointer(@Processes),nCount*SizeOf(DWORD),nProcess);
+  nProcess:=(nProcess div 4)-1;
+  for i:=2 to nProcess do //skip Idle & System
+  begin
+    hProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
+      False,Processes[i]);
+    if hProcess<>0 then
+    begin
+      GetModuleFilenameExW(hProcess,0,ModuleName,SizeOf(ModuleName));
+      result:=lstrcmpiw(ExtractW(ModuleName,true),exename)=0;
+      CloseHandle(hProcess);
+      if result then exit;
+    end;
+  end;
+end;
+
+//----- work with handles -----
+function GetProcessHandleCount(hProcess:THANDLE;var pdwHandleCount:dword):bool; stdcall; external 'kernel32.dll';
+
+function NtQueryObject(ObjectHandle:THANDLE;ObjectInformationClass:integer;
+         ObjectInformation:pointer;Length:ulong;var ResultLength:longint):cardinal; stdcall; external 'ntdll.dll';
+
+const
+  ObjectNameInformation = 1; // +4 bytes
+  ObjectTypeInformation = 2; // +$60 bytes
+const
+  STATUS_INFO_LENGTH_MISMATCH = $C0000004;
+
+function TranslatePath(fn:PWideChar):PWideChar;
+const
+  LANPrefix:PWideChar = '\Device\LanmanRedirector\';
+var
+  szTemp:array [0..511] of WideChar;
+  szName:array [0..511] of WideChar;
+  p:PWideChar;
+  uNameLen:word;
+  szTempFile:array [0..511] of WideChar;
+begin
+  if StrPosW(fn,LANPrefix)=fn then
+  begin
+    uNameLen:=StrLenW(LANPrefix);
+    mGetMem(result,(StrLenW(fn)-uNameLen+3)*SizeOf(WideChar));
+    result[0]:='\';
+    result[1]:='\';
+    StrCopyW(result+2,fn+uNameLen);
+    exit;
+  end;
+  if GetLogicalDriveStringsW(255,@szTemp)<>0 then
+  begin
+    p:=szTemp;
+    repeat
+      p[2]:=#0;
+      if QueryDosDeviceW(p,szName,255)<>0 then
+      begin
+        uNameLen:=StrLenW(szName)+1;
+        if uNameLen<255 then
+        begin
+          StrCopyW(szTempFile,fn,uNameLen-1);
+          if lstrcmpiw(szTempFile,szName)=0 then
+          begin
+            mGetMem(result,(StrLenW(fn+uNameLen)+4)*SizeOf(WideChar));
+            result[0]:=WideChar(ORD(p[0]));
+            result[1]:=':';
+            result[2]:='\';
+            StrCopyW(result+3,fn+uNameLen);
+            exit;
+          end;
+        end;
+      end;
+      inc(p,4);
+    until p^=#0;
+  end;
+  StrDupW(result,fn);
+end;
+
+const
+  maxhandles = 15;
+var
+  har,hold:array [0..maxhandles-1] of PWideChar;
+  harcnt:integer;
+const
+  oldcnt:integer=0;
+
+procedure ArSwitch(idx:integer);
+var
+  h:pWideChar;
+begin
+//clear old
+  while oldcnt>0 do
+  begin
+    dec(oldcnt);
+    FreeMem(hold[oldcnt]);
+  end;
+//copy new to old
+  move(har,hold,SizeOf(har));
+  oldcnt:=harcnt;
+// move active to begin
+  if idx<>0 then
+  begin
+    h        :=hold[idx];
+    hold[idx]:=hold[0];
+    hold[0]  :=h;
+  end;
+end;
+
+function CheckHandles(ReturnNew:bool):integer;
+var
+  i,j:integer;
+  flg:boolean;
+begin
+  result:=0;
+  if oldcnt=0 then //first time
+  begin
+    ArSwitch(0);
+    exit;
+  end;
+  i:=0;
+  if ReturnNew then
+  begin
+    while i<harcnt do
+    begin
+      flg:=false;
+      j:=0;
+      while j<oldcnt do
+      begin
+        if StrCmpW(har[i],hold[j])=0 then
+        begin
+          flg:=true; //old=new
+          break;
+        end;
+        inc(j);
+      end;
+      if not flg then  // new!!
+      begin
+        ArSwitch(i);
+        exit;
+      end;
+      inc(i);
+    end;
+  end
+  else
+  begin
+    while i<oldcnt do
+    begin
+      j:=0;
+      while j<harcnt do
+      begin
+        if StrCmpW(hold[i],har[j])=0 then
+        begin
+          ArSwitch(j);
+          exit;
+        end;
+        inc(j);
+      end;
+      inc(i);
+    end;
+  end;
+  ArSwitch(0);
+  result:=-1;
+end;
+
+const
+  MaxHandle = $2000;
+
+type
+  ptrec = ^trec;
+  trec = record
+    handle:thandle;
+    fname:pWideChar;
+  end;
+
+type
+  pint_ptr  = ^int_ptr;
+
+function GetName(param:pointer):integer; //stdcall;
+const
+  BufSize = $800;
+  // depends of record align
+  offset=SizeOf(Pointer) div 2; // 4 for win64, 2 for win32
+var
+  TmpBuf:array [0..BufSize-1] of WideChar;
+var
+  dummy:longint;
+  size:integer;
+  pc:pWideChar;
+begin
+  result:=0;
+
+  if NtQueryObject(ptrec(param)^.handle,ObjectNameInformation,
+     @TmpBuf,BufSize*SizeOf(WideChar),dummy)=0 then
+  begin
+    // UNICODE_STRING: 2b - length, 2b - maxlen, (align), next - pWideChar
+    size:=pword(@TmpBuf)^; // length in bytes
+    if size>=0 then
+    begin
+      GetMem(ptrec(param)^.fname,size+SizeOf(WideChar)); // length in bytes
+
+      pc:=pWideChar(pint_ptr(@TmpBuf[offset])^);
+      move(pc^,ptrec(param)^.fname^,size); // can be without zero
+      pword(pAnsiChar(ptrec(param)^.fname)+size)^:=0;
+    end
+    else
+      ptrec(param)^.fname:=nil;
+  end;
+end;
+
+function TestHandle(Handle:THANDLE;MultiThread:bool;timeout:cardinal):pWideChar;
+var
+  hThread:THANDLE;
+  rec:trec;
+//  dummy:longint;
+  res:{$IFDEF COMPILER_16_UP}Longword{$ELSE}uint_ptr{$ENDIF};
+begin
+  result:=nil;
+{
+  // check what it - file
+  if (NtQueryObject(Handle,ObjectTypeInformation,
+     @TmpBuf,BufSize*SizeOf(WideChar),dummy)<>0) or
+     (StrCmpW(TmpBuf+$30,'File')<>0) then
+    Exit;
+}
+  // check what it disk file
+//!!! need to check again
+  if GetFileType(Handle)<>FILE_TYPE_DISK then exit;
+
+  rec.handle:=Handle;
+  rec.fname:=nil;
+
+  if not MultiThread then
+  begin
+    GetName(@rec);
+    result:=rec.fname;
+  end
+  else
+  begin
+    hThread:=BeginThread(nil,0,@GetName,@rec,0,res);
+    if WaitForSingleObject(hThread,timeout)=WAIT_TIMEOUT then
+    begin
+      TerminateThread(hThread,0);
+    end
+    else
+      result:=rec.fname;
+    CloseHandle(hThread);
+  end;
+end;
+
+function GetFileFromWnd(wnd:HWND;Filter:tFFWFilterProc;
+         flags:dword=gffdMultiThread+gffdOld;timeout:cardinal=ThreadTimeout):pWideChar;
+var
+  hProcess,h:THANDLE;
+  pid:THANDLE;
+  i:THANDLE;
+  c:THANDLE;
+  handles:dword;
+  pc:pWideChar;
+begin
+  result:=nil;
+  GetWindowThreadProcessId(wnd,@c);
+  pid:=OpenProcess(//PROCESS_VM_READ or
+    PROCESS_DUP_HANDLE or PROCESS_QUERY_INFORMATION {or PROCESS_QUERY_LIMITED_INFORMATION},
+    true,c);
+  if pid=0 then exit;
+  harcnt:=0;
+  if GetProcessHandleCount(pid,handles) then
+  begin
+    handles:=handles*4; // count no matter, check "every 4th" handle
+//    Handles:=Handles*SizeOf(THANDLE);
+    hProcess:=GetCurrentProcess;
+    i:=SIZEOF(THANDLE); // skip first
+
+    while true do
+    begin
+      if DuplicateHandle(pid,i,hProcess,@h,GENERIC_READ,false,0) then
+      begin
+        pc:=TestHandle(h,(flags and gffdMultiThread)<>0,timeout);
+        if pc<>nil then
+        begin
+  //        if GetFileType(h)=FILE_TYPE_DISK then
+          begin
+            if (@Filter=nil) or Filter(pc) and (harcnt<maxhandles) then
+            begin
+              har[harcnt]:=pc;
+              inc(harcnt);
+            end
+            else
+              FreeMem(pc);
+          end;
+        end;
+        CloseHandle(h);
+      end
+      else
+      begin
+//        inc(handles,SizeOf(THANDLE)); //????skip empty number and non-duplicates
+        inc(handles,4); //????skip empty number and non-duplicates
+        if handles>MaxHandle then break; //file not found
+      end;
+      inc(i,4);
+//!!      inc(i,SizeOf(THANDLE));
+      if i>handles then
+        break;
+    end;
+  end;
+
+  CloseHandle(pid);
+  if harcnt>0 then
+  begin
+    CheckHandles((flags and gffdOld)=0);
+    result:=TranslatePath(hold[0]);
+  end
+end;
+
+procedure ClearHandles;
+begin
+  while oldcnt>0 do
+  begin
+    dec(oldcnt);
+    FreeMem(hold[oldcnt]);
+  end;
+end;
+
+initialization
+finalization
+  ClearHandles;
+end.