Jump to content

ThomasRiedelDk

Members
  • Content Count

    9
  • Joined

  • Last visited

Everything posted by ThomasRiedelDk

  1. ThomasRiedelDk

    FireDaemon / NSSM clone?

    I am trying to run a Win32.exe from inside a service application, - trying to make a servicemanager similar to NSSM. I try with AppPath = 'C:\Windows\notepad.exe', I get an error like: "Required privilege missing". Any clous? function TMyService.StartProcessAsUser(const AppPath: string): Boolean; var StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; SecAttr: TSecurityAttributes; hToken, hDupToken: THandle; UserName, Password, Domain: string; begin Result := False; if LogonUser(PChar(FUserName), PChar(FDomain), PChar(FPassword), LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, hToken) then begin if DuplicateTokenEx(hToken, MAXIMUM_ALLOWED, nil, SecurityImpersonation, TokenPrimary, hDupToken) then begin ZeroMemory(@StartupInfo, SizeOf(TStartupInfo)); StartupInfo.cb := SizeOf(TStartupInfo); StartupInfo.lpDesktop := PChar('Winsta0\Default'); StartupInfo.dwFlags := STARTF_USESHOWWINDOW; StartupInfo.wShowWindow := SW_show; if CreateProcessAsUser(hDupToken, PChar(AppPath), nil, nil, nil, False, CREATE_NEW_CONSOLE or CREATE_UNICODE_ENVIRONMENT, nil, nil, StartupInfo, ProcessInfo) then begin Result := True; CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); end else begin var ErrCode := GetLastError(); var errormsg : string; SetLength(ErrorMsg, 512); FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, nil, ErrCode, 0, PChar(ErrorMsg), Length(ErrorMsg), nil); ShowMessage('Fejl ved start af proces: ' + ErrorMsg); end; CloseHandle(hDupToken); end; CloseHandle(hToken); end; end; function SetTokenPrivilege(const APrivilege: string; const AEnable: Boolean = true): Boolean; var LToken: THandle; LTokenPriv: TOKEN_PRIVILEGES; LPrevTokenPriv: TOKEN_PRIVILEGES; LLength: Cardinal; LErrval: Cardinal; begin Result := False; if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, LToken) then try // Get the locally unique identifier (LUID) . if LookupPrivilegeValue(nil, PChar(APrivilege), LTokenPriv.Privileges[0].Luid) then begin LTokenPriv.PrivilegeCount := 1; // one privilege to set case AEnable of True: LTokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; False: LTokenPriv.Privileges[0].Attributes := 0; end; LPrevTokenPriv := LTokenPriv; // Enable or disable the privilege Result := AdjustTokenPrivileges(LToken, False, LTokenPriv, SizeOf(LPrevTokenPriv), LPrevTokenPriv, LLength); end; finally CloseHandle(LToken); end; end; function TMyService.StartProcess(const AppPath: string): Boolean; begin SetTokenPrivilege('SeAssignPrimaryTokenPrivilege'); SetTokenPrivilege('SeTcbPrivilege'); // Giver fuld kontrol over tokens SetTokenPrivilege('SeIncreaseQuotaPrivilege'); SetTokenPrivilege('SeImpersonatePrivilege'); //result := StartProcessWithLogon(apppath, fusername, fpassword, fdomain); Result := StartProcessAsUser(AppPath); end;
  2. ThomasRiedelDk

    A TComboBox alternative not based on WinAPI

    Sounds good! Can you even make a version where you can locate an Item by typing, like csDropDown, but it must be an item from the list?
  3. Winsoft has made a driver for this. I have had the same issue, security is OK on a cloud server, with SSH - port forwarding. Do you know about other drivers?
  4. ThomasRiedelDk

    Simulate mousedrag

    I have this code, that simulates a mouse drag, moving the form: procedure TForm1.SimulateMouseDrag(FromX, FromY, ToX, ToY: Integer); begin SetCursorPos(Fromx, Fromy); mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0); // Simulate mouse down sleep(100); mouse_event(MOUSEEVENTF_MOVE, ToX-FromX, ToY-FromY, 0, 0); // Simulate mouse move sleep(100); SetCursorPos(Tox, Toy); mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0); // Simulate mouse up end; procedure TForm1.Button1Click(Sender: TObject); begin SimulateMouseDrag(left+5, top+5, left+200, top+200); end; It works, but the form shrinks during the operation. What am I missing?
  5. ThomasRiedelDk

    Simulate mousedrag

    Thanks. You are right. The resize area in the Top bar is quite large, and I was not aware that it even existed.
  6. ThomasRiedelDk

    Simulate mousedrag

    Right you are. Actually I did not even know, that forms were resizable from the top. I tried var dy := (Height - ClientHeight) div 2; It works as well. Thanks
  7. ThomasRiedelDk

    Simulate mousedrag

    Thanks for the reply, but it did not help, - still resizing the form. And the cursor turns into updown arrow shape.
  8. ThomasRiedelDk

    Simulate mousedrag

    It was just meant to slow down the process a bit.
  9. ThomasRiedelDk

    Simulate mousedrag

    Sleep does nothing, and that is intended..
×