function SetPrivilege(aPrivilegeName : string;
aEnabled : boolean ): boolean;
var
TPPrev,
TP : TTokenPrivileges;
Token : THandle;
dwRetLen : DWord;
begin
Result := False;
OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES
or TOKEN_QUERY, @Token );
TP.PrivilegeCount := 1;
if( LookupPrivilegeValue(nil, PChar( aPrivilegeName ),
TP.Privileges[ 0 ].LUID ) ) then
begin
if( aEnabled )then
TP.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED;
else
TP.Privileges[0].Attributes:= 0;
dwRetLen := 0;
Result := AdjustTokenPrivileges(Token,False,TP,
SizeOf( TPPrev ),
TPPrev,dwRetLen );
end;
CloseHandle( Token );
end;
function WinExit( iFlags : integer ) : boolean;
// possible Flags:
// EWX_LOGOFF
// EWX_REBOOT
// EWX_SHUTDOWN
begin
Result := True;
if( SetPrivilege( 'SeShutdownPrivilege', true ) ) then
begin
if( not ExitWindowsEx( iFlags, 0 ) )then
begin
Result := False;
end;
SetPrivilege( 'SeShutdownPrivilege', False )
end
else
begin
Result := False;
end;
end;
Found in the Win32.hlp
type
PTokenUser = ^TTokenUser;
_TOKEN_USER = record
User: TSIDAndAttributes;
end;
TTokenUser = _TOKEN_USER;
procedure getCurrentUserAndDomain(var User, Domain: String);
var
hProcess, hAccessToken: THandle;
InfoBuffer: array[0..1000] of Char;
szAccountName, szDomainName: array [0..200] of Char;
dwInfoBufferSize, dwAccountSize, dwDomainSize: DWORD;
pUser: PTokenUser;
snu: SID_NAME_USE;
begin
dwAccountSize:=200;
dwDomainSize:=200;
hProcess:=GetCurrentProcess;
OpenProcessToken(hProcess,TOKEN_READ,hAccessToken);
GetTokenInformation(hAccessToken,TokenUser,@InfoBuffer[0],1000,
dwInfoBufferSize);
pUser:=PTokenUser(@InfoBuffer[0]);
LookupAccountSid(nil, pUser.User.Sid, szAccountName, dwAccountSize, szDomainName, dwDomainSize, snu);
User:=szAccountName;
Domain:=szDomainName;
CloseHandle(hAccessToken);
end;
Parameters:
EWX_SHUTDOWN : shut down windows(Power off)
EWX_REBOOT : reboot windows
EWX_POWEROFF : Standby mode
EWX_LOGOFF : Log Off
procedure TForm1.Button1Click(Sender: TObject);
begin
ExitWindowsEx(EWX_SHUTDOWN,0);
end;
or use rundll32.exe
uses ShellAPI;
function ExecuteFile(const FileName, Params,DefaultDir : string;
ShowCmd: Integer) : THandle;
var
zFileName, zParams, zDir : array[0..79] of Char;
begin
Result :=ShellExecute(Application.MainForm.Handle, nil,
StrPCopy(zFileName, FileName),StrPCopy(zParams,Params), StrPCopy(zDir, DefaultDir), ShowCmd);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ExecuteFile('Rundll.exe','user,exitwindows','',SW_SHOW);
end;
implementation
function RegisterServiceProcess(dwProcessID, dwType: DWord) : DWord; stdcall;
external 'KERNEL32.DLL';
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessID,1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessID,0);
end;
Uses Messages;
...
public
procedure WMNCHitTest(var Message: TWMNCHitTest); message;
WM_NCHITTEST;
end;
...
procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
var
P : TPoint;
begin
inherited;
P := ScreenToClient(SmallPointToPoint(Message.Pos));
with imgTitle do
if (P.X >= Left) and (P.X < Left + Width) and (P.Y >= Top)
and (P.Y < Top + Height) then
Message.Result := htCaption;
end;
with Form1 do
SetWindowPos(Handle,
HWND_TOPMOST, Left, Top,Width, Height,SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
procedure RecycleFile(s : string);
var
SHFileOpStruct : TSHFileOpStruct;
begin
with SHFileOpStruct do
begin
Wnd := Handle;
wFunc := FO_DELETE; // we want to delete a file...
pFrom := PChar(s); //... this file ...
pTo := nil;
fFlags := FOF_ALLOWUNDO; //... able to "Undo" (recycle)
hNameMappings := nil;
lpszProgressTitle := nil;
end;
SHFileOperation(SHFileOpStruct); // to the Recycle Bin
end;
For Example we want to execute calc.exe. You may change with other executable application.
…
WinExec('C:\WINDOWS\CALC.EXE', SW_ShowNormal);
...
You can run the program Maximized - SW_ShowMaximized
You can run the program Minimized - SW_ShowMinimized
And you can run the program as Normal - SW_ShowNormal
procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Application.Handle, GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;
procedure TMainForm.FormShow(Sender: TObject);
var Owner : HWnd;
begin
Owner:=GetWindow(Handle,GW_OWNER);
ShowWindow(Owner,SW_HIDE);
end;
// Use SW_Show to show back the form
Question:
I wish to be able have an application to record sound and store to wav.
Could you show me?
Answer:
This application using Windows API and using mmsystem as the engine.
Please try this codes:
uses mmSystem;
{....}
procedure TForm1.Button1Click(Sender: TObject); // Record
begin
mciSendString('OPEN NEW TYPE WAVEAUDIO ALIAS mysound', nil, 0, Handle);
mciSendString('SET mysound TIME FORMAT MS ' + // set time
'BITSPERSAMPLE 8 ' + // 8 Bit
'CHANNELS 1 ' + // MONO
'SAMPLESPERSEC 8000 ' + // 8 KHz
'BYTESPERSEC 8000', // 8000 Bytes/s
nil, 0, Handle);
mciSendString('RECORD mysound', nil, 0, Handle)
end;
procedure TForm1.Button2Click(Sender: TObject); // Stop
begin
mciSendString('STOP mysound', nil, 0, Handle)
end;
procedure TForm1.Button3Click(Sender: TObject); // Save
var
verz: String;
begin
GetDir(0, verz);
mciSendString(PChar('SAVE mysound ' + verz + '/test.wav'), nil, 0, Handle);
mciSendString('CLOSE mysound', nil, 0, Handle)
end;
Question:
I would like to have application to replace keyboard function. Do you have the source code?
Answer:
Here the source code to simulate keyboard press.
Uses keybd_event to manufacture a series of key events matching
the passed parameters. The events go to the control with focus.
Note that for characters key is always the upper-case version of
the character. Sending without any modifier keys will result in
a lower-case character, sending it with [ssShift] will result
in an upper-case character!
{1. PostKeyEx32 function}
procedure PostKeyEx32(key: Word; const shift: TShiftState; specialkey: Boolean);
{************************************************************
* Procedure PostKeyEx32
*
* Parameters:
* key : virtual keycode of the key to send. For printable
* keys this is simply the ANSI code (Ord(character)).
* shift : state of the modifier keys. This is a set, so you
* can set several of these keys (shift, control, alt,
* mouse buttons) in tandem. The TShiftState type is
* declared in the Classes Unit.
* specialkey: normally this should be False. Set it to True to
* specify a key on the numeric keypad, for example.
* Description:
* Uses keybd_event to manufacture a series of key events matching
* the passed parameters. The events go to the control with focus.
* Note that for characters key is always the upper-case version of
* the character. Sending without any modifier keys will result in
* a lower-case character, sending it with [ssShift] will result
* in an upper-case character!
************************************************************}
type
TShiftKeyInfo = record
shift: Byte;
vkey: Byte;
end;
byteset = set of 0..7;
const
shiftkeys: array [1..3] of TShiftKeyInfo =
((shift: Ord(ssCtrl); vkey: VK_CONTROL),
(shift: Ord(ssShift); vkey: VK_SHIFT),
(shift: Ord(ssAlt); vkey: VK_MENU));
var
flag: DWORD;
bShift: ByteSet absolute shift;
i: Integer;
begin
for i := 1 to 3 do
begin
if shiftkeys[i].shift in bShift then
keybd_event(shiftkeys[i].vkey, MapVirtualKey(shiftkeys[i].vkey, 0), 0, 0);
end; { For }
if specialkey then
flag := KEYEVENTF_EXTENDEDKEY
else
flag := 0;
keybd_event(key, MapvirtualKey(key, 0), flag, 0);
flag := flag or KEYEVENTF_KEYUP;
keybd_event(key, MapvirtualKey(key, 0), flag, 0);
for i := 3 downto 1 do
begin
if shiftkeys[i].shift in bShift then
keybd_event(shiftkeys[i].vkey, MapVirtualKey(shiftkeys[i].vkey, 0),
KEYEVENTF_KEYUP, 0);
end; { For }
end; { PostKeyEx32 }
procedure TForm1.Button1Click(Sender: TObject);
begin
PostKeyEx32(VK_LWIN, [], False);
PostKeyEx32(Ord('D'), [], False);
PostKeyEx32(Ord('C'), [ssctrl, ssAlt], False);
end;
{************************************************************}
{2. With keybd_event API}
procedure TForm1.Button1Click(Sender: TObject);
begin
{or you can also try this simple example to send any
amount of keystrokes at the same time. }
{Pressing the A Key and showing it in the Edit1.Text}
Edit1.SetFocus;
keybd_event(VK_SHIFT, 0, 0, 0);
keybd_event(Ord('A'), 0, 0, 0);
keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYUP, 0);
{Presses the Left Window Key and starts the Run}
keybd_event(VK_LWIN, 0, 0, 0);
keybd_event(Ord('R'), 0, 0, 0);
keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0);
end;
{***********************************************************}
{3. With keybd_event API}
procedure PostKeyExHWND(hWindow: HWnd; key: Word; const shift: TShiftState;
specialkey: Boolean);
{************************************************************
* Procedure PostKeyEx
*
* Parameters:
* hWindow: target window to be send the keystroke
* key : virtual keycode of the key to send. For printable
* keys this is simply the ANSI code (Ord(character)).
* shift : state of the modifier keys. This is a set, so you
* can set several of these keys (shift, control, alt,
* mouse buttons) in tandem. The TShiftState type is
* declared in the Classes Unit.
* specialkey: normally this should be False. Set it to True to
* specify a key on the numeric keypad, for example.
* If this parameter is true, bit 24 of the lparam for
* the posted WM_KEY* messages will be set.
* Description:
* This
procedure sets up Windows key state array to correctly
* reflect the requested pattern of modifier keys and then posts
* a WM_KEYDOWN/WM_KEYUP message pair to the target window. Then
* Application.ProcessMessages is called to process the messages
* before the keyboard state is restored.
* Error Conditions:
* May fail due to lack of memory for the two key state buffers.
* Will raise an exception in this case.
* NOTE:
* Setting the keyboard state will not work across applications
* running in different memory spaces on Win32 unless AttachThreadInput
* is used to connect to the target thread first.
*Created: 02/21/96 16:39:00 by P. Below
************************************************************}
type
TBuffers = array [0..1] of TKeyboardState;
var
pKeyBuffers: ^TBuffers;
lParam: LongInt;
begin
(* check if the target window exists *)
if IsWindow(hWindow) then
begin
(* set local variables to default values *)
pKeyBuffers := nil;
lParam := MakeLong(0, MapVirtualKey(key, 0));
(* modify lparam if special key requested *)
if specialkey then
lParam := lParam or $1000000;
(* allocate space for the key state buffers *)
New(pKeyBuffers);
try
(* Fill buffer 1 with current state so we can later restore it.
Null out buffer 0 to get a "no key pressed" state. *)
GetKeyboardState(pKeyBuffers^[1]);
FillChar(pKeyBuffers^[0], SizeOf(TKeyboardState), 0);
(* set the requested modifier keys to "down" state in the buffer*)
if ssShift in shift then
pKeyBuffers^[0][VK_SHIFT] := $80;
if ssAlt in shift then
begin
(* Alt needs special treatment since a bit in lparam needs also be set *)
pKeyBuffers^[0][VK_MENU] := $80;
lParam := lParam or $20000000;
end;
if ssCtrl in shift then
pKeyBuffers^[0][VK_CONTROL] := $80;
if ssLeft in shift then
pKeyBuffers^[0][VK_LBUTTON] := $80;
if ssRight in shift then
pKeyBuffers^[0][VK_RBUTTON] := $80;
if ssMiddle in shift then
pKeyBuffers^[0][VK_MBUTTON] := $80;
(* make out new key state array the active key state map *)
SetKeyboardState(pKeyBuffers^[0]);
(* post the key messages *)
if ssAlt in Shift then
begin
PostMessage(hWindow, WM_SYSKEYDOWN, key, lParam);
PostMessage(hWindow, WM_SYSKEYUP, key, lParam or $C0000000);
end
else
begin
PostMessage(hWindow, WM_KEYDOWN, key, lParam);
PostMessage(hWindow, WM_KEYUP, key, lParam or $C0000000);
end;
(* process the messages *)
Application.ProcessMessages;
(* restore the old key state map *)
SetKeyboardState(pKeyBuffers^[1]);
finally
(* free the memory for the key state buffers *)
if pKeyBuffers <> nil then
Dispose(pKeyBuffers);
end; { If }
end;
end; { PostKeyEx }
procedure TForm1.Button1Click(Sender: TObject);
var
targetWnd: HWND;
begin
targetWnd := FindWindow('notepad', nil)
if targetWnd <> 0 then
begin
PostKeyExHWND(targetWnd, Ord('I'), [ssAlt], False);
end;
end;
{***********************************************************}
{3. With SendInput API}
procedure TForm1.Button1Click(Sender: TObject);
const
Str: string = 'writing writing writing';
var
Inp: TInput;
I: Integer;
begin
Edit1.SetFocus;
for I := 1 to Length(Str) do
begin
Inp.Itype := INPUT_KEYBOARD;
Inp.ki.wVk := Ord(UpCase(Str[i]));
Inp.ki.dwFlags := 0;
SendInput(1, Inp, SizeOf(Inp));
Inp.Itype := INPUT_KEYBOARD;
Inp.ki.wVk := Ord(UpCase(Str[i]));
Inp.ki.dwFlags := KEYEVENTF_KEYUP;
SendInput(1, Inp, SizeOf(Inp));
Application.ProcessMessages;
Sleep(80);
end;
end;
procedure SendAltTab;
var
KeyInputs: array of TInput;
KeyInputCount: Integer;
procedure KeybdInput(VKey: Byte; Flags: DWORD);
begin
Inc(KeyInputCount);
SetLength(KeyInputs, KeyInputCount);
KeyInputs[KeyInputCount - 1].Itype := INPUT_KEYBOARD;
with KeyInputs[KeyInputCount - 1].ki do
begin
wVk := VKey;
wScan := MapVirtualKey(wVk, 0);
dwFlags := KEYEVENTF_EXTENDEDKEY;
dwFlags := Flags or dwFlags;
time := 0;
dwExtraInfo := 0;
end;
end;
begin
KeybdInput(VK_MENU, 0); // Alt
KeybdInput(VK_TAB, 0); // Tab
KeybdInput(VK_TAB, KEYEVENTF_KEYUP); // Tab
KeybdInput(VK_MENU, KEYEVENTF_KEYUP); // Alt
SendInput(KeyInputCount, KeyInputs[0], SizeOf(KeyInputs[0]));
end;
Question:
I want to put CPU speed on my 'About' Form. Can you help me?
Answer:
I will give you systax for getting CPU Speed.
I think your About Form will looks nice with this.
function GetCPUSpeed: Double;
const
DelayTime = 500;
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
asm
dw 310Fh
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000 * DelayTime);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(Format('Your CPU speed: %f MHz', [GetCPUSpeed]));
end;
{Note:
You should call the GetCPUSpeed
function more than
one time to get a good result. }
Question:
It will be nice if I can associate an application to a file extension. I know, windows already has it, but I wish to have more simple and faster application. How?
Answer:
This can only be done with work around in registry,
thanks God, and thanks to borland that delphi has uses to complete this work done.
Here the example.
uses
registry, shlobj;
procedure TForm1.RegisterFileType(prefix: string; exepfad: string);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CLASSES_ROOT;
reg.OpenKey('.' + prefix, True);
try
reg.Writestring('', prefix + 'file');
finally
reg.CloseKey;
end;
reg.CreateKey(prefix + 'file');
reg.OpenKey(prefix + 'file\DefaultIcon', True);
try
reg.Writestring('', exepfad + ',0');
finally
reg.CloseKey;
end;
reg.OpenKey(prefix + 'file\shell\open\command', True);
try
reg.Writestring('', exepfad + ' "%1"');
finally
reg.CloseKey;
end;
finally
reg.Free;
end;
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterFileType('pci', 'c:\file.exe');
end;
Question:
Can we get information in who's login this application running?
Answer:
I have the code to check whether the application running in administrator login or not. And tested successfully using windows NT/2000. You can explore by yourself to get your goal through this example.
const
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =
(Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;
function IsAdmin: Boolean;
var
hAccessToken: THandle;
ptgGroups: PTokenGroups;
dwInfoBufferSize: DWORD;
psidAdministrators: PSID;
x: Integer;
bSuccess: BOOL;
begin
Result := False;
bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
hAccessToken);
if not bSuccess then
begin
if GetLastError = ERROR_NO_TOKEN then
bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
hAccessToken);
end;
if bSuccess then
begin
GetMem(ptgGroups, 1024);
bSuccess := GetTokenInformation(hAccessToken, TokenGroups,
ptgGroups, 1024, dwInfoBufferSize);
CloseHandle(hAccessToken);
if bSuccess then
begin
AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
0, 0, 0, 0, 0, 0, psidAdministrators);
{$R-}
for x := 0 to ptgGroups.GroupCount - 1 do
if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then
begin
Result := True;
Break;
end;
{$R+}
FreeSid(psidAdministrators);
end;
FreeMem(ptgGroups);
end;
end;
Question:
Are there any new BDE API functions?
Answer:
Yes. DbiAddDriver and DbiDeleteDriver let you add and remove
ODBC drivers from the current BDE configuration or session. The
BDE now automatically adds ODBC drivers and data sources as BDE
aliases to the active session when they aren't currently stored
in the configuration file. Also, please look at the
www.borland.com/devsupport/bde/bdeapiex/index.html page for examples not found in
the BDE32 help file.
Question:
How to capture clipboard content?
Answer:
I give you an example to folow.
Make new project, and place TImage and TMemo.
Those object will use to show clipboard content, if Image will shows at Image1 and if text will shows at Memo1.
uses Clipboard;
...
procedure TForm1.Button1Click(Sender: TObject);
var
MyHandle: THandle;
begin
Clipboard.Open;
if Clipboard.HasFormat(CF_TEXT) then
begin
MyHandle:=Clipboard.GetAsHandle(CF_TEXT);
Memo1.Lines.Add(StrPas(GlobalLock(MyHandle)));
GlobalUnlock(MyHandle);
end;
if (Clipboard.HasFormat(CF_BITMAP)) or
(Clipboard.HasFormat(CF_PICTURE)) then
Image1.Picture.Assign(Clipboard);
Clipboard.Close;
end;
Question:
I want to change System time from my application immediatelly.
Do you have the code?
Answer:
Sure,
The input strings for date and time depends on the format you are using.
procedure TForm1.Button1Click(Sender: TObject);
var
SystemTime: TSystemTime;
NewTime, NewDate: string;
begin
NewTime := '12:00:00';
NewDate := '01.01.2006';
DateTimeToSystemTime(StrToDate(NewDate) + StrToTime(NewTime), SystemTime);
SetLocalTime(SystemTime);
// Tell windows, that the Time changed!
PostMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0); // *
end;
CLICK TO REGISTER
