From cb4a46e7fbe62d788e66ed6121c717a2d22a4d7c Mon Sep 17 00:00:00 2001 From: watcherhd Date: Thu, 21 Apr 2011 14:14:52 +0000 Subject: svn.miranda.im is moving to a new home! git-svn-id: http://miranda-plugins.googlecode.com/svn/trunk@7 e753b5eb-9565-29b2-b5c5-2cc6f99dfbcb --- delphi/Awkward/utils/syswin.pas | 734 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 734 insertions(+) create mode 100644 delphi/Awkward/utils/syswin.pas (limited to 'delphi/Awkward/utils/syswin.pas') diff --git a/delphi/Awkward/utils/syswin.pas b/delphi/Awkward/utils/syswin.pas new file mode 100644 index 0000000..d22700e --- /dev/null +++ b/delphi/Awkward/utils/syswin.pas @@ -0,0 +1,734 @@ +unit SysWin; +{$include compilers.inc} + +interface + +uses windows; + +type + FFWFilterProc = function(fname:pWideChar):boolean; + +const + ThreadTimeout = 50; +const + gffdMultiThread = 1; + gffdOld = 2; + +function GetWorkOfflineStatus:integer; + +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 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 GetEXEbyWnd(w:HWND; var dst:pWideChar):pWideChar; overload; +function GetEXEbyWnd(w:HWND; var dst:PAnsiChar):PAnsiChar; overload; +function IsExeRunning(exename:PWideChar):boolean; {hwnd} +function GetFileFromWnd(wnd:HWND;Filter:FFWFilterProc; + flags:dword=gffdMultiThread+gffdOld):pWideChar; + +function WaitFocusedWndChild(Wnd:HWnd):HWnd; + +implementation + +uses shellapi,PSAPI,common,messages; + +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 ExecuteWaitW(AppPath:pWideChar; CmdLine:pWideChar=nil; DfltDirectory:PWideChar=nil; + Show:DWORD=SW_SHOWNORMAL; TimeOut:DWORD=0; ProcID:PDWORD=nil):dword; +var + Flags: DWORD; + Startup: {$IFDEF DELPHI10_UP}TStartupInfoW{$ELSE}TStartupInfo{$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; + Startup: {$IFDEF DELPHI10_UP}TStartupInfoA{$ELSE}TStartupInfo{$ENDIF}; +// Startup: TStartupInfoA; + 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; + +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(Msg); + if Unicode then + DispatchMessageW(Msg) + else + DispatchMessageA(Msg); + end; + end + else + break; + until false; +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 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; + +type + TThreadInfo = record + ftCreationTime:TFileTime; + dwUnknown1:dword; + dwStartAddress:dword; + dwOwningPID:dword; + dwThreadID:dword; + dwCurrentPriority:dword; + dwBasePriority:dword; + dwContextSwitches:dword; + dwThreadState:dword; + dwUnknown2:dword; + dwUnknown3:dword; + dwUnknown4:dword; + dwUnknown5:dword; + dwUnknown6:dword; + dwUnknown7:dword; + end; + + TProcessInfo = record + dwOffset:dword; + dwThreadCount:dword; + dwUnknown1:array[0..5] of dword; + ftCreationTime:TFileTime; + ftUserTime:int64; + ftKernelTime:int64; + wLength:word; + wMaximumLength:word; + pszProcessName:pWideChar; + dwBasePriority:dword; + dwProcessID:dword; + dwParentProcessID:dword; + dwHandleCount:dword; +// not interesting + dwUnknown7:dword; + dwUnknown8:dword; + dwVirtualBytesPeak:dword; + dwVirtualBytes:dword; + dwPageFaults:dword; + dwWorkingSetPeak:dword; + dwWorkingSet:dword; + dwUnknown9:dword; + dwPagedPool:dword; + dwUnknown10:dword; + dwNonPagedPool:dword; + dwPageFileBytesPeak:dword; + dwPageFileBytes:dword; + dwPrivateBytes:dword; + dwUnknown11:dword; + dwUnknown12:dword; + dwUnknown13:dword; + dwUnknown14:dword; + ati:array[0..0] of TThreadInfo; + end; + +function NtQuerySystemInformation(si_class:cardinal;si:pointer;si_length:cardinal;ret_length:cardinal):cardinal; stdcall; external 'ntdll.dll'; +function NtQueryObject(ObjectHandle:THANDLE;ObjectInformationClass:dword;ObjectInformation:pointer;Length:dword;var ResultLength:dword):cardinal; stdcall; external 'ntdll.dll'; +const + ObjectNameInformation = 1; // +4 bytes + ObjectTypeInformation = 2; // +$60 bytes +const + STATUS_INFO_LENGTH_MISMATCH = $C0000004; + +function GetHandleCount(pid:dword):dword; +var + buf:pointer; + pi:^TProcessInfo; +begin +{BOOL GetProcessHandleCount( + HANDLE hProcess, + PDWORD pdwHandleCount +} + mGetMem(buf,300000); + NtQuerySystemInformation(5, buf, 300000, 0); + pi:=buf; + result:=0; + repeat + pi:=pointer(cardinal(pi)+pi^.dwOffset); //first - Idle process + if pi^.dwProcessID=pid then + begin + result:=pi^.dwHandleCount; + break; + end; + if pi^.dwOffset=0 then + break; + until false; + mFreeMem(buf); +end; + +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; + +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 + j:integer; + h:pWideChar; +begin +//clear old + j:=0; + while j0 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 i0) or + (StrCmpW(TmpBuf+$30,'File')<>0) 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,pdword(nil)^); + if WaitForSingleObject(hThread,ThreadTimeout)=WAIT_TIMEOUT then + begin + TerminateThread(hThread,0); + end + else + result:=rec.fname; + CloseHandle(hThread); + end; +end; + +function GetFileFromWnd(wnd:HWND;Filter:FFWFilterProc; + flags:dword=gffdMultiThread+gffdOld):pWideChar; +var + hProcess,h:THANDLE; + pid:dword; + i:cardinal; + c:thandle; + Handles:dword; + pc:pWideChar; +begin + result:=nil; + i:=4; + GetWindowThreadProcessId(wnd,@c); + pid:=OpenProcess(PROCESS_DUP_HANDLE,true,c); + Handles:=GetHandleCount(c)*4; + harcnt:=0; + hProcess:=GetCurrentProcess; + + while true do + begin + if DuplicateHandle(pid,i,hProcess,@h,GENERIC_READ,false,0) then + begin + pc:=TestHandle(h,(flags and gffdMultiThread)<>0); + if pc<>nil then + begin +// if GetFileType(h)=FILE_TYPE_DISK then + begin + if (@Filter=nil) or Filter(pc) and (harcntMaxHandle then break; //file not found + end; + inc(i,4); + if i>Handles then + break; + end; + + CloseHandle(pid); + if harcnt>0 then + begin + CheckHandles((flags and gffdOld)=0); + result:=translatePath(hold[0]); + end +end; + +end. -- cgit v1.2.3