How can I check if keybd_event was successful? - delphi

I have this code right here that modifies the clipboard and then restores it back:
function SetClipText(szText:WideString):Boolean;
var
pData: DWORD;
dwSize: DWORD;
begin
Result := FALSE;
if OpenClipBoard(0) then
begin
dwSize := (Length(szText) * 2) + 2;
if dwSize <> 0 then
begin
pData := GlobalAlloc(MEM_COMMIT, dwSize);
if pData <> 0 then
begin
CopyMemory(Pointer(pData), #szText[1], dwSize - 2);
if SetClipBoardData(CF_UNICODETEXT, pData) <> 0 then
Result := TRUE;
end;
end;
CloseClipBoard;
end;
end;
function GetClipText(var szText:WideString):Boolean;
var
hData: DWORD;
pData: Pointer;
dwSize: DWORD;
begin
Result := FALSE;
if OpenClipBoard(0) then
begin
hData := GetClipBoardData(CF_UNICODETEXT);
if hData <> 0 then
begin
pData := GlobalLock(hData);
if pData <> nil then
begin
dwSize := GlobalSize(hData);
if dwSize <> 0 then
begin
SetLength(szText, (dwSize div 2) - 1);
CopyMemory(#szText[1], pData, dwSize);
Result := TRUE;
end;
GlobalUnlock(DWORD(pData));
end;
end;
CloseClipBoard;
end;
end;
var
OldClip : WideString;
begin
repeat until GetClipText (OldClip);
repeat until SetClipText ('NewClipBoardText');
// PASTE
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
keybd_event(Ord('V'), MapVirtualKey(Ord('V'), 0), 0, 0);
keybd_event(Ord('V'), MapVirtualKey(Ord('V'), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);
repeat until SetClipText (OldClip);
end.
I use keybd_event to paste new clipboard text to a window (e.g. notepad).
It seems like that keybd_event is so fast, that repeat until SetClipText (OldClip); get's called before the keys got pressed. Is there way to check when and if the keys were pressed?

keybd_event never fails. It merely places they event that you specify into the currently active input queue.
Because the function is asynchronous the keyboard event is not processed until the other application gets round to processing it. So, most likely the other application has not processed the keyboard event by the time you call SetClipText. You can't expect to know when a particular keyboard event is processed, unless you have control of the other application. But in that case you would not be communicating with it by faking input.

Related

printer settings don't change (winapi: documentproperties)

Language: delphi 6
I succeeded in opening the dialog using documentproperties.
However, I changed the settings and clicked OK, but it does not change.
I want to change the paper to A3.
Please tell me how to do it.
code:
var
FPrinterHandle:THandle;
aDevice: array[0..255] of char;
DevMode: PDeviceMode;
StubDevMode: TDeviceMode;
DeviceMode: THandle;
begin
strpcopy(aDevice, Combobox1.Text);
if OpenPrinter(aDevice,FPrinterHandle,nil) then begin
DeviceMode := GlobalAlloc(GHND, DocumentProperties(self.handle, FPrinterHandle, ADevice, StubDevMode, StubDevMode, 0));
if DeviceMode <> 0 then begin
DevMode := GlobalLock(DeviceMode);
DocumentProperties(0, FPrinterHandle, ADevice, DevMode^, DevMode^, DM_OUT_BUFFER);
DevMode^.dmFields := DM_PAPERSIZE;
DevMode^.dmPaperSize := DMPAPER_A3;
DocumentProperties(0, FPrinterHandle, ADevice, DevMode^, DevMode^, DM_OUT_BUFFER or DM_IN_BUFFER);
GlobalUnlock(DeviceMode);
GlobalFree(DeviceMode);
end;
end;
end;
It's not the code I wrote, it's from somewhere. Hope it helps.
Pass the printer name and desired paper size as parameters. (I used GetPrinter procedure)
If parameter(integer) is 0, it is set to A3, and if it is 1, it is set to A4.
And when I printed pdf file with shellexecute, I checked that it prints in the desired size.
※ Before print, the tray of the printer should be set to 'automatic selection'.
procedure SetPrinterInfo(APrinterName: PChar; Psize: Integer);
var
HPrinter : THandle;
InfoSize, BytesNeeded: Cardinal;
DevMode: PDeviceMode;
PI2: PPrinterInfo2;
PrinterDefaults: TPrinterDefaults;
begin
with PrinterDefaults do
begin
DesiredAccess := PRINTER_ACCESS_USE;
pDatatype := nil;
pDevMode := nil;
end;
if OpenPrinter(APrinterName, HPrinter, #PrinterDefaults) then
try
SetLastError(0);
//Determine the number of bytes to allocate for the PRINTER_INFO_2 construct...
if not GetPrinter(HPrinter, 2, nil, 0, #BytesNeeded) then
begin
//Allocate memory space for the PRINTER_INFO_2 pointer (PrinterInfo2)...
PI2 := AllocMem(BytesNeeded);
try
InfoSize := SizeOf(TPrinterInfo2);
if GetPrinter(HPrinter, 2, PI2, BytesNeeded, #BytesNeeded) then
begin
DevMode := PI2.pDevMode;
DevMode.dmFields := DevMode.dmFields or DM_PAPERSIZE;
if Psize = 0 then DevMode.dmPaperSize := DMPAPER_A3
else if Psize = 1 then DevMode.dmPaperSize := DMPAPER_A4;
PI2.pSecurityDescriptor := nil;
// Apply settings to the printer
if DocumentProperties(0, hPrinter, APrinterName, PI2.pDevMode^,
PI2.pDevMode^, DM_IN_BUFFER or DM_OUT_BUFFER) = IDOK then
begin
SetPrinter(HPrinter, 2, PI2, 0); // Ignore the result of this call...
end;
end;
finally
FreeMem(PI2, BytesNeeded);
end;
end;
finally
ClosePrinter(HPrinter);
end;
end;

How to get icon for hidden file (like Explorer) for ListView in Delphi?

I useSHGetFileInfo('', 0, aFileInfo, SizeOf(TSHFileInfo), SHGFI_ICON or SHGFI_SYSICONINDEX) to extract an icon list in TImageList and then associate index with TListView. Which flag I must use to get hidden style like Explorer?
To the best of my knowledge, the system does not offer such functionality. You need to create faded icons yourself, based on the original icon. You can use a function along these lines to do that:
function CreateFadedIcon(Icon: HICON): HICON;
type
TRGBA = record
B,G,R,A: Byte
end;
procedure InitialiseBitmapInfoHeader(Width, Height: Integer; var bih: BITMAPINFOHEADER);
begin
bih.biSize := SizeOf(BITMAPINFOHEADER);
bih.biWidth := Width;
bih.biHeight := 2*Height;//height of xor bitmap plus height of and bitmap
bih.biPlanes := 1;
bih.biBitCount := 32;
bih.biCompression := BI_RGB;
end;
procedure CreateXORbitmap(const sbih, dbih: BITMAPINFOHEADER; sptr, dptr: PDWORD);
var
i, j: Integer;
begin
for i := 0 to sbih.biHeight-1 do begin
for j := 0 to sbih.biWidth-1 do begin
dptr^ := sptr^;
TRGBA(dptr^).A := TRGBA(dptr^).A div 3;
inc(dptr);//relies on the fact that no padding is needed for RGBA scanlines
inc(sptr);//likewise
end;
end;
end;
var
IconInfo: TIconInfo;
sBits, xorBits: PDWORD;
xorScanSize, andScanSize: Integer;
xorBitsSize, andBitsSize: Integer;
sbih: BITMAPINFOHEADER;
dbih: ^BITMAPINFOHEADER;
resbitsSize: DWORD;
resbits: Pointer;
begin
Result := 0;
Try
if not GetIconInfo(Icon, IconInfo) then begin
exit;
end;
Try
GetDIBheaderAndBits(IconInfo.hbmColor, sbih, Pointer(sBits));
if Assigned(sBits) then begin
Try
if (sbih.biPlanes<>1) or (sbih.biBitCount<>32) then begin
exit;
end;
xorScanSize := BytesPerScanline(sbih.biWidth, 32, 32);
Assert(xorScanSize=SizeOf(DWORD)*sbih.biWidth);
andScanSize := BytesPerScanline(sbih.biWidth, 1, 32);
xorBitsSize := sbih.biHeight*xorScanSize;
andBitsSize := sbih.biHeight*andScanSize;
resbitsSize := SizeOf(BITMAPINFOHEADER) + xorBitsSize + andBitsSize;
resbits := AllocMem(resbitsSize);//AllocMem zeroises the memory
Try
dbih := resbits;
InitialiseBitmapInfoHeader(sbih.biWidth, sbih.biHeight, dbih^);
xorBits := resbits;
inc(PByte(xorBits), SizeOf(BITMAPINFOHEADER));
CreateXORbitmap(sbih, dbih^, sBits, xorBits);
//don't need to fill in the mask bitmap when using RGBA
Result := CreateIconFromResourceEx(resbits, resbitsSize, True, $00030000, sbih.biWidth, sbih.biHeight, LR_DEFAULTCOLOR);
Finally
FreeMem(resbits);
End;
Finally
FreeMem(sBits);
End;
end;
Finally
if IconInfo.hbmMask<>0 then begin
DeleteObject(IconInfo.hbmMask);
end;
if IconInfo.hbmColor<>0 then begin
DeleteObject(IconInfo.hbmColor);
end;
End;
Finally
DestroyIcon(Icon);
End;
end;

Unsuccessfully trying to send keys in Delphi XE6

Below is the complete routine I'm using to send the key Ctrl + Shift + S to a PDF document. It should show the save dialog but fails to do so.
The procedure opens a pdf document residing in sFolder using GetFiles. There is only one pdf doc in sFolder.
As you can see from the commented out lines, I also tried the sndkey32 without success.
procedure TForm1.Button1Click(Sender: TObject);
var
oBrowser: TBrowseForFolder;
oList: TStringDynArray;
sFile: string;
sFolder: string;
oShellExecuteInfo: TShellExecuteInfo;
begin
oBrowser := TBrowseForFolder.Create(self);
oBrowser.Execute;
sFolder := oBrowser.Folder;
oBrowser.Free;
if DirectoryExists(sFolder) then begin
oList := TDirectory.GetFiles(sFolder, '*.pdf', TSearchOption.soAllDirectories);
if Length(oList) > 0 then begin
for sFile in oList do begin
FillChar(oShellExecuteInfo, SizeOf(oShellExecuteInfo), 0);
oShellExecuteInfo.cbSize := SizeOf(TShellExecuteInfo);
with oShellExecuteInfo do begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Application.Handle;
lpFile := PChar(sFile);
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(#oShellExecuteInfo) then begin
ShowWindow(oShellExecuteInfo.Wnd, 1);
SetForegroundWindow(oShellExecuteInfo.Wnd);
Winapi.Windows.SetFocus(oShellExecuteInfo.Wnd);
SendKey(Ord('s'), [ssCtrl, ssShift], False);
// if sndkey32.AppActivate('adobe') then
// sndkey32.SendKeys('^+S', False);
end;
end;
end;
end;
end;
procedure TForm1.SendKey(key: Word; const shift: TShiftState; specialkey: Boolean);
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;
j: Integer;
begin
for j := 1 to 3 do begin
if shiftkeys[j].shift in bShift then keybd_event(shiftkeys[j].vkey, MapVirtualKey(shiftkeys[j].vkey, 0), 0, 0);
end;
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 j := 3 downto 1 do begin
if shiftkeys[j].shift in bShift then keybd_event(shiftkeys[j].vkey, MapVirtualKey(shiftkeys[j].vkey, 0), KEYEVENTF_KEYUP, 0);
end;
end;
The window oShellExecuteInfo.Wnd is a window in your Delphi process. You assign it as Application.Handle. You seem to be hoping that it will be the main window of the PDF viewer but that's not the case.
So you need to find the main window of the PDF viewer. That involves a call to EnumerateWindows to get all top level windows. Then, for each one, use GetWindowThreadProcessId to test whether or not the window is owned by the PDF viewer process.
Some other comments:
You neglect error checking when calling API functions.
You should use SendInput rather than keybd_event.
You leak the process handle returned by ShellExecuteEx.
It is possible that ShellExecuteEx does not return a process handle at all. That depends on how the file association is setup, and whether or not Acrobat was already running.
You may need to wait until the new process has finished starting up before you send input.
Your program seems to assume that the installed PDF viewer is Acrobat. What if it is not?

How to get the master volume in windows xp?

In Windows XP, with Delphi, how to get the master volume?
I know I can set up and down sending key strokes with keybd_event(VK_VOLUME_UP, 1, 0, 0); and keybd_event(VK_VOLUME_DOWN, 1, 0, 0);, but I don't know how to get the actual value of the volume.
The below is a little modification on the example code found here (credited there is Thomas Stutz). The example there sets the microphone volume. I just modified the component type - speaker destination instead of microphone source, and replaced mixerSetControlDetails with mixerGetControlDetails, and turned the setter into a getter of course. On the few systems I tested here (XPSp3, XPSp2, W2K, 98), it seems to work. The return of the function is the speaker out of the first (default) mixer - a value of 0-65535, the 'ShowMessage' in the button handler changes it into a percentage. But don't ask me more details about it, I really have no experience with the mixer api. Instead refer here f.i., though old the article really seemed to be comprehensive to me.
function GetSpeakerVolume(var bValue: Word): Boolean;
var {0..65535}
hMix: HMIXER;
mxlc: MIXERLINECONTROLS;
mxcd: TMIXERCONTROLDETAILS;
vol: TMIXERCONTROLDETAILS_UNSIGNED;
mxc: MIXERCONTROL;
mxl: TMixerLine;
intRet: Integer;
nMixerDevs: Integer;
begin
Result := False;
// Check if Mixer is available
nMixerDevs := mixerGetNumDevs();
if (nMixerDevs < 1) then
Exit;
// open the mixer
intRet := mixerOpen(#hMix, 0, 0, 0, 0);
if intRet = MMSYSERR_NOERROR then
begin
mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
mxl.cbStruct := SizeOf(mxl);
// get line info
intRet := mixerGetLineInfo(hMix, #mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
if intRet = MMSYSERR_NOERROR then
begin
ZeroMemory(#mxlc, SizeOf(mxlc));
mxlc.cbStruct := SizeOf(mxlc);
mxlc.dwLineID := mxl.dwLineID;
mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
mxlc.cControls := 1;
mxlc.cbmxctrl := SizeOf(mxc);
mxlc.pamxctrl := #mxc;
intRet := mixerGetLineControls(hMix, #mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
if intRet = MMSYSERR_NOERROR then
begin
ZeroMemory(#mxcd, SizeOf(mxcd));
mxcd.dwControlID := mxc.dwControlID;
mxcd.cbStruct := SizeOf(mxcd);
mxcd.cMultipleItems := 0;
mxcd.cbDetails := SizeOf(vol);
mxcd.paDetails := #vol;
mxcd.cChannels := 1;
intRet := mixerGetControlDetails(hMix, #mxcd, MIXER_GETCONTROLDETAILSF_VALUE);
if intRet <> MMSYSERR_NOERROR then
ShowMessage('GetControlDetails Error')
else begin
bValue := vol.dwValue;
Result := True;
end;
end
else
ShowMessage('GetLineInfo Error');
end;
intRet := mixerClose(hMix);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Vol: Word;
begin
if GetSpeakerVolume(Vol) then
ShowMessage(IntToStr(Round(Vol * 100 / 65535)));
end;

Windows Global Keyboard Hook - Delphi

I've created a GLOBAL keyboard hook DLL, using source code found on the internet. For the best part it works brilliant, except when it comes to browsers.
It picks up every key in the browser except, it seems, when the browser gets focus, it looses the first key that is pressed. Tested this in IE and Firefox and it seems to be the same for both.
For instance, if I open IE and start typing www. , I only get back ww. If the browser window stays in focus no further keys are lost. As soon as the browser looses focus and regains focus, the first key is again missing.
Could it be because of using only WH_KEYDOWN instead of WH_KEYPRESS / WH_KEYUP ? Can anyone shed some light on this please?
Thank you
PS: The hook function itself is below: The DLL is sent a memo box and app handle to wich the DLL will send messages as well as a usermessage.
function KeyHookFunc(Code, VirtualKey, KeyStroke: Integer): LRESULT; stdcall;
var
KeyState1: TKeyBoardState;
AryChar: array[0..1] of Char;
Count: Integer;
begin
Result := 0;
if Code = HC_NOREMOVE then Exit;
Result := CallNextHookEx(hKeyHook, Code, VirtualKey, KeyStroke);
{I moved the CallNextHookEx up here but if you want to block
or change any keys then move it back down}
if Code < 0 then
Exit;
if Code = HC_ACTION then
begin
if ((KeyStroke and (1 shl 30)) <> 0) then
if not IsWindow(hMemo) then
begin
{I moved the OpenFileMapping up here so it would not be opened
unless the app the DLL is attatched to gets some Key messages}
hMemFile := OpenFileMapping(FILE_MAP_WRITE, False, 'NetParentMAP');//Global7v9k
PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
if PHookRec1 <> nil then
begin
hMemo := PHookRec1.MemoHnd;
hApp := PHookRec1.AppHnd;
end;
end;
if ((KeyStroke AND (1 shl 31)) = 0) then //if ((KeyStroke and (1 shl 30)) <> 0) then
begin
GetKeyboardState(KeyState1);
Count := ToAscii(VirtualKey, KeyStroke, KeyState1, AryChar, 0);
if Count = 1 then
begin
SendMessage(hMemo, WM_CHAR, Ord(AryChar[0]), 0);
{I included 2 ways to get the Charaters, a Memo Hnadle and
a WM_USER+1678 message to the program}
PostMessage(hApp, WM_USER + 1678, Ord(AryChar[0]), 0);
end;
end;
end;
end;
You are not assigning your hMemo and hApp values early enough. You are waiting until a notification with a "previous state" flag of 1, which indicates a key has been held down for at least 1 repeat count, or is being released, whichever occurs first. Thus, hMemo and hApp are not available yet when your hook detects its first key down notification. That is why you miss characters. Try this instead:
function KeyHookFunc(Code, VirtualKey, KeyStroke: Integer): LRESULT; stdcall;
var
KeyState1: TKeyBoardState;
AryChar: array[0..1] of Char;
Count: Integer;
begin
Result := CallNextHookEx(hKeyHook, Code, VirtualKey, KeyStroke);
if Code <> HC_ACTION then Exit;
{ a key notification had occured, prepare the HWNDs
before checking the actual key state }
if (hMemo = 0) or (hApp = 0) then
begin
if hMemFile = 0 then
begin
hMemFile := OpenFileMapping(FILE_MAP_WRITE, False, 'NetParentMAP');
if hMemFile = 0 then Exit;
end;
if PHookRec1 = nil then
begin
PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
if PHookRec1 = nil then Exit;
end;
hMemo := PHookRec1.MemoHnd;
hApp := PHookRec1.AppHnd;
if (hMemo = 0) and (hApp = 0) then Exit;
end;
if ((KeyStroke and (1 shl 31)) = 0) then // a key is down
begin
GetKeyboardState(KeyState1);
Count := ToAscii(VirtualKey, KeyStroke, KeyState1, AryChar, 0);
if Count = 1 then
begin
if hMemo <> 0 then SendMessage(hMemo, WM_CHAR, Ord(AryChar[0]), 0);
if hApp <> 0 then PostMessage(hApp, WM_USER + 1678, Ord(AryChar[0]), 0);
end;
end;
end;

Resources