changing a variable and using it as a key - arrays

I bought a new mouse which has a wheel on it and I've made it so a variable (Quote_Selector) increases or decreases from which way the secondary mouse wheel turns. The integer from this variable is also the key in which defines which message my button sendsfrom the array. The problem is trying to link the Quote_Selector as a key to pull which message is in the array shown and send it. My goal is to try and make this as clean as possible as well. And I've even tried using
For key [,value] in expression but I can't seem to come up with anything. i am using the AutoHotKey language and software.
; Declare Variables
Quote_Selector = 0
Min_Selector_Range = 0
Max_Selector_Range = 3
; Declare Message Choices
MessageArray := []
MessageArray[0] := "Darude - Sandstorm"
MessageArray[1] := "Rekt"
MessageArray[2] := "I cry all the time"
MessageArray[3] := "My anaconda don't"
return
; Forward Key Command
$=::
{
If Quote_Selector < %Max_Selector_Range%
Quote_Selector ++
Send, %Quote_Selector%
}
return
; Backward Key Command
$-::
{
If Quote_Selector > %Min_Selector_Range%
Quote_Selector --
Send, %Quote_Selector%
}
return
; Enter Chat Command
$0::
{
Send, {Enter}
Send, /all{space} %value%
Send, {enter}
}
return

; Declare Variables
Quote_Selector := 0
Min_Selector_Range := 0
Max_Selector_Range := 3
; Declare Message Choices
MessageArray := []
MessageArray[0] = "Darude - Sandstorm"
MessageArray[1] = "Rekt"
MessageArray[2] = "Ready to meme"
MessageArray[3] = "My anaconda don't"
return
; Forward Key Command
$=::
If (Quote_Selector < Max_Selector_Range)
{
Quote_Selector := Quote_Selector + 1
}
return
; Backward Key Command
$-::
If (Quote_Selector > Min_Selector_Range)
{
Quote_Selector := Quote_Selector - 1
}
return
; Enter Chat Command
$0::
Send, {Enter}
CurrentMessage := MessageArray[%Quote_Selector%]
Send, /all{Space} %CurrentMessage%
Send, {Enter}
CurrentMessage := ""
return
The code shown uses two keys to change the message to previous or next, and pressing the send button sends that the text provided in the array.

Try this:
; Declare Variables
Quote_Selector := 0
Min_Selector_Range := 0
Max_Selector_Range := 3
; Declare Message Choices
MessageArray := []
MessageArray[0] := "Darude - Sandstorm"
MessageArray[1] := "Rekt"
MessageArray[2] := "I cry all the time"
MessageArray[3] := "My anaconda don't"
return
; Forward Key Command
$=::
If (Quote_Selector < Max_Selector_Range)
{
Quote_Selector := Quote_Selector + 1
CurrentMessage := MessageArray[Quote_Selector]
Send, %CurrentMessage%
CurrentMessage := ""
}
return
; Backward Key Command
$-::
If (Quote_Selector > Min_Selector_Range)
{
Quote_Selector := Quote_Selector - 1
CurrentMessage := MessageArray[Quote_Selector]
Send, %CurrentMessage%
CurrentMessage := ""
}
return
; Enter Chat Command
$0::
Send, {Enter}
Send, /all{space} %value%
Send, {enter}
return
Is this what you want script to do?
Your mistakes:
Always place { after if statement condition in a new line, not before if statement.
It is not an actual error but always try to use := instead of = for assigning numeric values.
Always enclose if statement condition in ().
As far as I know you can't directly use array item with Send command. Put array item to another variable and after use that variable with Send command.
Hotkey does not need to be enclosed in {}.
Also, always use AutoHotkey and its documenatation from http://ahkscript.org/ (current uptodate version, new official website)! AutoHotkey and its documentation from autohotkey.com is outdated and you may have some problems using them!

Related

Reading from mouse inputs in Ada

I have a procedure in Ada which reads from a touch screen input. The code is very old and I do not have the touch screen anymore. I would like to replace the touch screen code with reading from a mouse input. Would it be simpler to write the function in C and Import it into the Ada code? The code below is the touch screen code.
HIL_NAME : STRING (1.. 10) := "/dev/touch";
procedure READ (X, Y : out INTEGER) is
type BYTE is new INTEGER range 0 .. 255;
for BYTE'SIZE use 8;
package IN_IO is new SEQUENTIAL_IO (BYTE);
use IN_IO;
type DATA_TYPE is array (2 .. 9) of BYTE;
HIL_FILE : IN_IO.FILE_TYPE;
COUNT : BYTE;
DATA : DATA_TYPE;
begin
IN_IO.OPEN (HIL_FILE, IN_FILE, HIL_NAME); -- open the touchscreen
loop
IN_IO.READ (HIL_FILE, COUNT); -- read the incoming record size
-- read the incoming record
for I in INTEGER range 2 .. BYTE'POS (COUNT) loop
IN_IO.READ (HIL_FILE, DATA (I));
end loop;
-- is this a fingerdown? overkill test.
if ((COUNT = 9) and (DATA (6) = 2#01000010#) and (DATA (9) = 142)) then
X := BYTE'POS (DATA (7)); -- pick out coordinates
Y := BYTE'POS (DATA (8));
IN_IO.CLOSE (HIL_FILE); -- close touchscreen to flush buffer
return; -- return to caller
end if;
end loop;
end READ;
It would be useful to know OS, version, compiler, window manager toolkit and version. For example I'm running Debian 10, and with Gnome 3 as my WM I can most easily access the mouse using the GTKAda toolkit. Last time I wrote code directly accessing a mouse was on DOS, in Modula-2.
However, GTKAda is not particularly easy to learn...
If you're willing to use a web browser as the GUI to your app (which also helps portability across systems ... you might even run the app on a PC but access it via a tablet or phone, giving you a touchscreen!) I recommend looking at Gnoga available from www.gnoga.com. Take a look at some of its tutorials, they should be easy to build and get you started accessing mouse and simple drawing.
EDIT
Having found the magic words (Centos, ncurses) in various comments (which you could usefully add to the question, in case there are better answers) what you are looking for is an Ada binding to ncurses such as this one. This binding is part of the official ncurses source since version 5.8 so should already be available on Centos.
It should then be a simple matter of writing a Read procedure which calls the ncurses mouse handling package, returning mouse position (scaled to an 8-bit Integer or Natural, and probably offset from the console window origin) whenever the LH button is pressed, otherwise presumably returning ... whatever an OUT parameter is initialised to, (presumably BYTE'FIRST)
Job done.
Now we can see the touch screen filename si part of the /dev/ hierarchy it may be even simpler to see if there is any mileage in finding documentation on /dev/mouse as #zerte suggests (or /dev/input/mouse[0|1] on my laptop) ... but I think ncurses will be less machine-dependent.
I have solved the problem using Ncurses. I downloaded the terminal-interface-curses and used the files to create the following procedure.
with Terminal_Interface.Curses;
use Terminal_Interface.Curses;
tmp2 : Event_Mask;
c : Key_Code;
firsttime : Bollean;
procedure READ (X1 : out Column_Position;
Y1 : Line_Position) is
begin
tmp2 := Start_Mouse (All_Events);
c:= Character'Pos ('?');
Set_Raw_Mode (SwitchOn => True);
Set_KeyPad_Mode (SwitchOn => True);
firsttime := true;
loop
if not firsttime then
if c = KeyMouse then
declare
event : Mouse_Event;
Y : Line_Position;
X : Column_Position;
Button : Mouse_Button;
State : Mouse_State;
begin
event := Get_Mouse;
Get_Event (event, Y, X, Button, State);
X1 := X;
Y1 := Y;
exit;
end;
end if;
end if;
firsttime := False;
loop
c := Get_Keystroke;
exit when c /= Key_None;
end loop;
end loop;
End_Mouse (tmp2);
end READ;
You can read the mouse by using the Linux input subsystem (as was suggested by #Zerte). See also this question on SO and some kernel documentation here and here. Reading the mouse' input doesn't seem hard (at least not on a Raspberry Pi 3 running Raspbian GNU/Linux 10). Of course, you still need to apply proper scaling and you need to figure out the device that exposes the mouse events (in my case: /dev/input/event0)
NOTE: You can find the number by inspecting the output of sudo dmesg | grep "input:". If a mouse (or other pointing device) is connected to inputX, then the events of this device will be exposed on eventX.
main.adb
with Ada.Text_IO;
with Ada.Sequential_IO;
with Interfaces.C;
procedure Main is
package C renames Interfaces.C;
use type C.unsigned_short;
use type C.int;
-- Input event codes (linux/input-event-codes.h)
EV_SYN : constant := 16#00#;
EV_KEY : constant := 16#01#;
EV_REL : constant := 16#02#;
EV_ABS : constant := 16#03#;
EV_MSC : constant := 16#04#;
BTN_MOUSE : constant := 16#110#;
BTN_LEFT : constant := 16#110#;
BTN_RIGHT : constant := 16#111#;
BTN_MIDDLE : constant := 16#112#;
REL_X : constant := 16#00#;
REL_Y : constant := 16#01#;
REL_WHEEL : constant := 16#08#;
-- Time value (sys/time.h)
subtype suseconds_t is C.long;
subtype time_t is C.long;
type timeval is record
tv_sec : time_t;
tv_usec : suseconds_t;
end record;
pragma Convention (C, timeval);
-- Input event struct (linux/input.h)
type input_event is record
time : timeval;
typ : C.unsigned_short;
code : C.unsigned_short;
value : C.int;
end record;
pragma Convention (C, input_event);
-- ... and a package instantiation for sequential IO.
package Input_Event_IO is new Ada.Sequential_IO (input_event);
use Input_Event_IO;
File : File_Type;
Event : input_event;
-- Position of the mouse and wheel.
X, Y, W : C.int := 0;
begin
Open (File, In_File, "/dev/input/event0");
-- Infinite loop, use Ctrl-C to exit.
loop
-- Wait for a new event.
Read (File, Event);
-- Process the event.
case Event.typ is
when EV_SYN =>
Ada.Text_IO.Put_Line
(X'Image & "," & Y'Image & " [" & W'Image & "]");
when EV_KEY =>
case Event.code is
when BTN_LEFT =>
Ada.Text_IO.Put_Line ("Left button.");
when BTN_MIDDLE =>
Ada.Text_IO.Put_Line ("Middle button.");
when BTN_RIGHT =>
Ada.Text_IO.Put_Line ("Right button.");
when others =>
null;
end case;
when EV_REL =>
case Event.code is
when REL_X =>
X := X + Event.value;
when REL_Y =>
Y := Y + Event.value;
when REL_WHEEL =>
W := W + Event.value;
when others =>
null;
end case;
when EV_ABS =>
case Event.code is
when REL_X =>
X := Event.value;
when REL_Y =>
Y := Event.value;
when REL_WHEEL =>
W := Event.value;
when others =>
null;
end case;
when others =>
null;
end case;
end loop;
end Main;
output (running on a headless RPi 3)
pi#raspberrypi:~/mouse $ sudo obj/main
[...]
-85, 9 [-5]
-84, 9 [-5]
-83, 9 [-5]
Left button.
-83, 9 [-5]
Left button.
-83, 9 [-5]
Left button.
-83, 9 [-5]
Left button.
-83, 9 [-5]
Right button.
-83, 9 [-5]
Right button.
-83, 9 [-5]
Middle button.
-83, 9 [-5]
Middle button.
-83, 9 [-5]
-84, 9 [-5]
^C
pi#raspberrypi:~/mouse $

How to wait 1 second using Structured Text?

I am currently writing a program that, when a variable reaches a certain point, a connected light will flash on and off every second. I know the light is properly hooked up, and I know that the program to alternate between on and off works, because it did it multiple times a second. I tried adding a wait timer to slow the flashing down.
Here is the chunk of code I am trying to add:
VAR
delay : TON;
Count : INT := 0;
END_VAR
delay(IN := TRUE, PT:= T#5S);
IF NOT (delay.Q) THEN
RETURN;
END_IF;
delay(IN := FALSE);
When I add it to my code, I get the error invalid time constant.
I'm not sure if it matters too much, but I am using Schneider Electric's EcoStruxure Machine Expert to write and execute my code.
For those that wish to see the entire program, if it would help, here it is:
IF (change < 70) THEN
Light13 := FALSE;
END_IF;
IF (change >= 70) AND (change <= 90) THEN
Light13 := TRUE;
END_IF;
IF (change > 90) THEN
WHILE change > 90 DO
IF (index MOD 2 = 0) THEN
Light13 := TRUE;
END_IF;
IF (index MOD 2 <> 0) THEN
Light13 := FALSE;
END_IF;
delay(IN := TRUE, PT:= T#5s);
IF NOT (delay.Q) THEN
RETURN;
END_IF;
delay(IN := FALSE);
index := index + 1;
END_WHILE;
END_IF;
To avoid getting a repeat question to this question, Timers in PLC - Structured Text, I will again reiterate that I am getting an error using this method. Just wanted to clarify beforehand.
I am not at all set on using this way if there is a better option. Thanks for the help!
Schneider Electric's EcoStruxure Machine Expert is CoDeSys based. So you have a few options.
Use BLINK in Util library
Open library manager, search for BLINK and double click it. Now you have blink block available. Use it like this.
VAR
fbBlink: BLINK;
END_VAR
fbBlink(ENABLE := TRUE, TIMELOW := T#1s, TIMEHIGH := T#300ms, OUT => bSignal);
The advantage of this method that you can set a different times for LOW and HIGH states of your lite and use different signals. For instance, short blink once a 2 seconds error 1 and short blink every half second error 2.
Create your own BLINK function as it is suggested by #Filippo.
If you want to flash your light on and off each second you can use this code:
Declaration part:
FUNCTION_BLOCK FB_Flash
VAR_INPUT
tFlashTime : TIME;
END_VAR
VAR_OUTPUT
bSignal : BOOL;
END_VAR
VAR
fbTonDelay : TON;
END_VAR
Implementation part:
fbTonDelay(IN := NOT fbTonDelay.q, PT:= tFlashTime);
IF fbTonDelay.Q
THEN
bSignal := NOT bSignal;
END_IF
You can call it like this:
fbFlash(tFlashTime := T#1S, bSignal => bFlashLight);
Where bFlashLight is your hardware output.
Now if you want the light to flash when a special condition is fullfilled, you can do like this:
IF bSpecialCondition
THEN
fbFlash(tFlashTime := T#1S, bSignal => bFlashLight);
ELSE
bFlashLight := FALSE;
END_IF
Try to reach your goals with maximum simplicity and clarity.

autohotkey gui in loop

So...I've been at this for a while but am definitely still horrible at it.
To summarize:
I'd like to start the next iteration of the loop after clicking specific options in certain guis.
In my research I've discovered that you can't have any returns in the loop. The problem is I have no idea how to make this work without returns.
Please HELP!
Thanks,
Marc S
(TRIMMED!)
`
Startline := 5
Loop, 10
{
CurrentRow := (StartLine - 1) + A_Index ;*****
;----------------***GETTING THE DATA***----------------
ControlFocus,, Proto_Names - Excel
Sleep, 200
oNamesDoc := ComObjActive("Excel.Application")
Global AlertStatus := oNamesDoc.Range("C" CurrentRow).Text
Global AlertQualifier := oNamesDoc.Range("D" CurrentRow).text
Global First := oNamesDoc.Range("H" CurrentRow).text
Global Last := oNamesDoc.Range("I" CurrentRow).text
Global State := oNamesDoc.Range("J" CurrentRow).text
Global Type := oNamesDoc.Range("M" CurrentRow).text
Global HMSStatus := oNamesDoc.Range("P" CurrentRow).text
Global HMSQualifier := oNamesDoc.Range("Q" CurrentRow).text
Global LicenseNo := oNamesDoc.Range("N" CurrentRow).text
Global Scrubbed := oNamesDoc.Range("AB" CurrentRow).value
;----------------***GETTING THE DATA***----------------
;Gui
Gui, 2:Add, Text,x1 y8, Blah Blah
Gui, 2:Add, Button, x1 y40, License
Gui, 2:Add, Button, x80 y40, Name
Gui, 2:Show, , blah blah - Row %CurrentRow% ; Important because it references A_Index
return
2GuiClose:
Gui, 2:Destroy
return
2ButtonLicense:
Gui, 2:Submit
Gui, 2:Destroy
;Another GUI
Gui, 3:Add, Text,x1 y8, Text
Gui, 3:Add, Text,x170 y132, Row %CurrentRow% ;Important because it references A_index
Gui, 3:Add, Button,x1 y125 , blah
Gui, 3:Show, , blah blah
return
3GuiClose:
Gui, 3:Destroy
return
3ButtonAgree:
Gui, 3:Submit
Gui, 3:Destroy
MsgBox, Click OK for Next
continue
}
`
To summarize further:
Goal:
Loop the following:
1. Gui #1: option a | option b also would like to display the A_Index
If option A or B is chosen, goto Gui #2
Gui #2: option c | option d also would like to display the A_Index
If option c, start next iteration of loop from gui 1.
If option d, goto Gui #3
Gui #3: Checkbox E|F|G|H
If any option is selected, i'd like to update a xslx file (i can figure that part out) and then start the next iteration of the loop.
The documentation for Loop suggests you can used break to exit the loop early. Is this what you are trying to achieve with the return?
You could set a return variable, break, and return that?
Edit after clarification:
I think the best way to do this would be to separate each gui out as a function, that just runs the loops you use here.
Have a main loop, and a global variable saying what the next loop to enter is.
Then each function can set this variable.
global NextLoop:=1
main(){
global NextLoop
loop{
if NextLoop == 1 {
gui1()
}else if NextLoop == 2 {
gui2()
} ; etc...
}
}
gui1(){
global NextLoop
loop{
if ; user chooses an option {
NextLoop := 2
return
}
}
}
gui2(){
global NextLoop
loop{
if ; user chooses c {
NextLoop := 1
return
}
if ; user chooses d {
NextLoop := 3
return
}
}
}
}
Fill out that code, and it should work.
Thanks for the suggestion but I think I have it figured out. Check out the code below and I'll try to answer any questions. It's so pretty....
LoopTot := (Endline - StartLine) + 1
Loop, %LoopTot% ;***Starts the loop***
{
Global CurrentRow := (StartLine - 1) + A_Index
;----------------***GETTING THE DATA***----------------
ControlFocus,, Proto_Names - Excel
Sleep, 200
oNamesDoc := ComObjActive("Excel.Application")
Global AlertStatus := oNamesDoc.Range("C" CurrentRow).Text
Global AlertQualifier := oNamesDoc.Range("D" CurrentRow).text
Global First := oNamesDoc.Range("H" CurrentRow).text
Global Last := oNamesDoc.Range("I" CurrentRow).text
Global State := oNamesDoc.Range("J" CurrentRow).text
Global Type := oNamesDoc.Range("M" CurrentRow).text
Global HMSStatus := oNamesDoc.Range("P" CurrentRow).text
Global HMSQualifier := oNamesDoc.Range("Q" CurrentRow).text
Global LicenseNo := oNamesDoc.Range("N" CurrentRow).text
Global Scrubbed := oNamesDoc.Range("AB" CurrentRow).value
;----------------***GETTING THE DATA***----------------
Gui, 2:font, s12, Verdana
Gui, 2:Add, Text,x1 y8, %First% %Last% License:%LicenseNo%
Gui, 2:Add, Button, x1 y40, License
Gui, 2:Add, Button, x80 y40, Name
Gui, 2:Show, , Search Options - Row %CurrentRow%
WinWaitClose, Search Options - Row %CurrentRow%
If Var = 1
Continue
If Var = 2
Continue
}
msgbox DONE!
ExitApp
2ButtonLicense:
Var = 1
Gui, 2:Destroy
CALicense1()
LicenseAgreeDisagree()
return
return
2ButtonName:
Var = 2
Gui, 2:Destroy
CAName1()
NameAgreeDisagree()
return
return

Dynamic array of bytes to string

For a project, I need to read a name inside a TrueType font file (.ttf). I written a code to do that, inspirated from a c++ example. Here is the code:
TWByteArray = array of Byte;
TWAnsiCharArray = array of AnsiChar;
...
//---------------------------------------------------------------------------
class function TWStringHelper.ByteToStr(const bytes: TWByteArray): string;
begin
SetLength(Result, Length(bytes));
if Length(Result) > 0 then
Move(bytes[0], Result[1], Length(bytes));
end;
//---------------------------------------------------------------------------
class function TWStringHelper.UniStrToByte(const str: UnicodeString): TWByteArray;
begin
SetLength(Result, Length(str) * SizeOf(WideChar));
if (Length(Result) > 0) then
Move(str[1], Result[0], Length(Result));
end;
//---------------------------------------------------------------------------
class function TWStringHelper.BytesToUniStr(const bytes: TWByteArray): UnicodeString;
begin
SetLength(Result, Length(bytes) div SizeOf(WideChar));
if Length(Result) > 0 then
Move(bytes[0], Result[1], Length(bytes));
end;
//---------------------------------------------------------------------------
...
//---------------------------------------------------------------------------
class function TWControlFont.SwapWord(value: Word): Word;
begin
Result := MakeWord(HiByte(value), LoByte(value));
end;
//---------------------------------------------------------------------------
class function TWControlFont.SwapLong(value: LongInt): LongInt;
begin
Result := MakeLong(SwapWord(HiWord(value)), SwapWord(LoWord(value)));
end;
//---------------------------------------------------------------------------
class function TWControlFont.GetFontNameFromFile(const fileName: UnicodeString): UnicodeString;
var
pFile: TFileStream;
offsetTable: ITTFOffsetTable;
dirTable: ITTFDirectoryTable;
nameHeader: ITTFNameTableHeader;
nameRecord: ITTFNameRecord;
nameBuffer: TWByteArray;//TWAnsiCharArray;
i: USHORT;
found: Boolean;
test2: string;
test3: UnicodeString;
test: Integer;
const name: array [0..3] of Byte = (Ord('n'), Ord('a'), Ord('m'), Ord('e'));
begin
// open font file
pFile := TFileStream.Create(fileName, fmOpenRead);
// succeeded?
if (not Assigned(pFile)) then
Exit;
try
pFile.Seek(0, soFromBeginning);
// read TTF offset table
if (pFile.Read(offsetTable, SizeOf(ITTFOffsetTable)) <> SizeOf(ITTFOffsetTable)) then
Exit;
offsetTable.m_NumOfTables := SwapWord(offsetTable.m_NumOfTables);
offsetTable.m_MajorVersion := SwapWord(offsetTable.m_MajorVersion);
offsetTable.m_MinorVersion := SwapWord(offsetTable.m_MinorVersion);
// is truetype font and version is 1.0?
if ((offsetTable.m_MajorVersion <> 1) or (offsetTable.m_MinorVersion <> 0)) then
Exit;
found := False;
// iterate through file tables
if (offsetTable.m_NumOfTables > 0) then
for i := 0 to offsetTable.m_NumOfTables - 1 do
begin
// read table
if (pFile.Read(dirTable, SizeOf(ITTFDirectoryTable)) <> SizeOf(ITTFDirectoryTable)) then
Exit;
// found name table?
if (CompareMem(#dirTable.m_Tag, #name, 4) = True) then
begin
found := True;
dirTable.m_Length := SwapLong(dirTable.m_Length);
dirTable.m_Offset := SwapLong(dirTable.m_Offset);
break;
end;
end;
// found name table?
if (not found) then
Exit;
// seek to name location
pFile.Position := dirTable.m_Offset;
// read name table header
if (pFile.Read(nameHeader, SizeOf(ITTFNameTableHeader)) <> SizeOf(ITTFNameTableHeader)) then
Exit;
nameHeader.m_NRCount := SwapWord(nameHeader.m_NRCount);
nameHeader.m_StorageOffset := SwapWord(nameHeader.m_StorageOffset);
// iterate through name records
if (nameHeader.m_NRCount > 0) then
for i := 0 to nameHeader.m_NRCount - 1 do
begin
// read name record
if (pFile.Read(nameRecord, SizeOf(ITTFNameRecord)) <> SizeOf(ITTFNameRecord)) then
Exit;
nameRecord.m_NameID := SwapWord(nameRecord.m_NameID);
// found font name?
if (nameRecord.m_NameID = 1) then
begin
// get font name length and offset
nameRecord.m_StringLength := SwapWord(nameRecord.m_StringLength);
nameRecord.m_StringOffset := SwapWord(nameRecord.m_StringOffset);
if (nameRecord.m_StringLength = 0) then
continue;
// calculate and seek to font name offset
pFile.Position := dirTable.m_Offset + nameRecord.m_StringOffset + nameHeader.m_StorageOffset;
try
SetLength(nameBuffer, nameRecord.m_StringLength + 1);
//REM FillChar(nameBuffer[0], nameRecord.m_StringLength + 1, $0);
// read font name from file
if (pFile.Read(nameBuffer[0], nameRecord.m_StringLength)
<> nameRecord.m_StringLength)
then
Exit;
nameBuffer[nameRecord.m_StringLength] := $0;
//OutputDebugString(PChar(nameBuffer));
//TWMemoryHelper.SwapBytes(nameBuffer[0], nameRecord.m_StringLength);
//OutputDebugString(PChar(nameBuffer));
//test := StringElementSize(RawByteString(#nameBuffer[0]));
//Result := TWStringHelper.BytesToUniStr(nameBuffer);
//Result := UnicodeString(AnsiString(TWStringHelper.ByteToStr(nameBuffer)));
//REM Result := UnicodeString(nameBuffer);
test2 := TWStringHelper.ByteToStr(nameBuffer);
OutputDebugStringA(PAnsiChar(test2));
test3 := UnicodeString(PAnsiChar(test2));
OutputDebugStringW(PWideChar(test3));
Result := test3;
OutputDebugStringW(PWideChar(test3));
finally
SetLength(nameBuffer, 0);
end;
break;
end;
end;
finally
pFile.Free;
end;
end;
//---------------------------------------------------------------------------
This code works well until the final part of the GetFontNameFromFile() function. There, things start to get complicated. Indeed, I'm unable to convert the nameBuffer byte array to a string in a correct manner.
The first problem I met is that the nameBuffer may be a simple ASCII string, or an UTF16 string, depend on file (I tried with the emoji.ttf available in FireFox, that returns an ASCII string, and Tahoma.ttf from my Win installation, that returns a UTF16 string). I need a way to determine that, and I don't know if there is a function or class in the VCL to do that.
The second problem is the conversion itself. The above code works more or less, but I feel that is not a correct solution. When I try to convert to an UnicodeString directly from nameBuffer, I get some strange crashes. If I try to convert nameBuffer to an AnsiString, the conversion seems success, however a conversion like UnicodeString(AnsiString(nameBuffer)) fails.
And the code seems to be full of memory issues. As I'm new with Delphi, I'm not very comfortable with the memory usage. For example, I suspect several issues with the byte array when I activate the
FillChar(nameBuffer[0], nameRecord.m_StringLength + 1, $0);
line.
So anybody can analyse this code and points me what I doing wrong?
Thanks in advance,
Regards

Delphi - Get Opened files by process using Handles

i'm actually programming an app to see what files are opened .
He is a part of a code that is not by me , i'm trying to using it but i don't understand it ...
I'm trying to get the file names opened by the process , but the function is always resulting like : /Default or /Sessions/1/Windows ... Something like that.Please help me and sorry for my bad english
const
SystemHandleInformation = $10;
STATUS_SUCCESS = $00000000;
STATUS_BUFFER_OVERFLOW = $80000005;
STATUS_INFO_LENGTH_MISMATCH = $C0000004;
DefaulBUFFERSIZE = $100000;
type
OBJECT_INFORMATION_CLASS = (ObjectBasicInformation, ObjectNameInformation,
ObjectTypeInformation, ObjectAllTypesInformation, ObjectHandleInformation);
SYSTEM_HANDLE = packed record
uIdProcess: ULONG;
ObjectType: UCHAR;
Flags: UCHAR;
Handle: Word;
pObject: Pointer;
GrantedAccess: ACCESS_MASK;
end;
PSYSTEM_HANDLE = ^SYSTEM_HANDLE;
SYSTEM_HANDLE_ARRAY = Array [0 .. 0] of SYSTEM_HANDLE;
PSYSTEM_HANDLE_ARRAY = ^SYSTEM_HANDLE_ARRAY;
SYSTEM_HANDLE_INFORMATION = packed record
uCount: ULONG;
Handles: SYSTEM_HANDLE_ARRAY;
end;
PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;
TNtQuerySystemInformation = function(SystemInformationClass: DWORD;
SystemInformation: Pointer; SystemInformationLength: DWORD;
ReturnLength: PDWORD): THandle; stdcall;
TNtQueryObject = function(ObjectHandle: cardinal;
ObjectInformationClass: OBJECT_INFORMATION_CLASS;
ObjectInformation: Pointer; Length: ULONG; ResultLength: PDWORD)
: THandle; stdcall;
UNICODE_STRING = packed record
Length: Word;
MaximumLength: Word;
Buffer: PWideChar;
end;
OBJECT_NAME_INFORMATION = UNICODE_STRING;
POBJECT_NAME_INFORMATION = ^OBJECT_NAME_INFORMATION;
Var
NTQueryObject: TNtQueryObject;
NTQuerySystemInformation: TNtQuerySystemInformation;
Procedure EnumerateOpenFiles();
var
sDummy: string;
hProcess: THandle;
hObject: THandle;
ResultLength: DWORD;
aBufferSize: DWORD;
aIndex: Integer;
pHandleInfo: PSYSTEM_HANDLE_INFORMATION;
HDummy: THandle;
lpwsName: PWideChar;
lpwsType: PWideChar;
lpszProcess: pchar;
begin
aBufferSize := DefaulBUFFERSIZE;
pHandleInfo := AllocMem(aBufferSize);
HDummy := NTQuerySystemInformation(DWORD(SystemHandleInformation),
pHandleInfo, aBufferSize, #ResultLength); // Get the list of handles
if (HDummy = STATUS_SUCCESS) then // If no error continue
begin
for aIndex := 0 to pHandleInfo^.uCount - 1 do // iterate the list
begin
hProcess := OpenProcess(PROCESS_DUP_HANDLE or PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ, False, pHandleInfo.Handles[aIndex].uIdProcess);
// open the process to get aditional info
if (hProcess <> INVALID_HANDLE_VALUE) then // Check valid handle
begin
hObject := 0;
if DuplicateHandle(hProcess, pHandleInfo.Handles[aIndex].Handle,
GetCurrentProcess, #hObject, STANDARD_RIGHTS_REQUIRED, False, 0) then
// Get a copy of the original handle
begin
lpwsName := GetObjectInfo(hObject, ObjectTypeInformation);
// Get the filename linked to the handle
if (lpwsName <> nil) then
begin
lpwsType := GetObjectInfo(hObject, ObjectNameInformation);
lpszProcess := AllocMem(MAX_PATH);
if GetModuleFileNameEx(hProcess, 0, lpszProcess, MAX_PATH) <> 0 then
// get the name of the process
sDummy := ExtractFileName(lpszProcess)
else
sDummy := 'System Process';
with MainForm.UsedFilesListView.Items.add do
begin
// Ajout
Caption := sDummy;
ImageIndex := -1;
SubItems.add(lpwsName);
end;
// Writeln('PID ', pHandleInfo.Handles[aIndex].uIdProcess);
// Writeln('Handle ', pHandleInfo.Handles[aIndex].Handle);
// Writeln('Process ', sDummy);
// Writeln('FileName ', string(lpwsName));
// Writeln;
FreeMem(lpwsName);
FreeMem(lpwsType);
FreeMem(lpszProcess);
end;
CloseHandle(hObject);
end;
CloseHandle(hProcess);
end;
end;
end;
FreeMem(pHandleInfo);
end;
First of all, you failed to provide SSCCE in your question, which greatly reduces chances for someone to take a look and try to fix your code. Because we would need to think about all missing declarations and what units to include to make compilable code, and yeah, thats boring.
Second, copy and paste programming is bad practice and it won't make your programming skills to improve. Try to consult MSDN about what certain APIs do and how to use them, then try to fiddle with the code by using informations you gathered through Google/MSDN.
About question itself, it's a tricky one, and widely undocumented.
Check this useful post on SysInternals forums which roughly explains what you have to do: HOWTO: Enumerate handles.
After acquiring file paths, you have to replace MS-DOS device paths with their mapped paths (e.g. \Device\HarddiskVolume1 > C:\). You can do that with GetLogicalDriveStrings and QueryDosDevice APIs.
Now the code itself. You would need JEDI API library to compile it. Tested on XE2:
{$APPTYPE CONSOLE}
program FileHandles;
uses
Winapi.Windows,
System.Classes,
JwaNative,
JwaNtStatus,
JwaWinternl;
procedure EnumerateDevicePaths(const ADeviceNames, ADevicePaths: TStringList);
var
drives : array[0..4095] of Char;
pdrive : PChar;
drive : String;
drive_path : array[0..4095] of Char;
sdrive_path: String;
begin
ADeviceNames.Clear;
ADevicePaths.Clear;
if GetLogicalDriveStrings(SizeOf(drives), drives) = 0 then
Exit;
pdrive := drives;
while pdrive^ <> #0 do
begin
drive := Copy(pdrive, 0, 4);
if drive <> '' then
begin
if drive[Length(drive)] = '\' then
Delete(drive, Length(drive), 1);
QueryDosDevice(PChar(drive), drive_path, SizeOf(drive_path));
sdrive_path := drive_path;
ADeviceNames.Add(drive);
ADevicePaths.Add(sdrive_path);
end;
Inc(pdrive, 4);
end;
end;
function EnumerateOpenFiles: Integer;
const
HANDLE_BUFFER_INCREASE_CHUNK = 16 * 1024; // increase handles buffer by 16kb
type
// this struct is missing in JEDI declarations (?)
TSystemHandleInformations = record
HandleCount: ULONG;
Handles : array[0..0] of TSystemHandleInformation;
end;
PSystemHandleInformations = ^TSystemHandleInformations;
var
phandles_info : PSystemHandleInformations;
phandles_size : DWORD;
retcode : DWORD;
C1, C2 : Integer;
phandle_info : PSystemHandleInformation;
process_handle: THandle;
dup_handle : THandle;
obj_name_info : PObjectNameInformation;
obj_name_size : DWORD;
fname : String;
device_names : TStringList;
device_paths : TStringList;
begin
device_names := TStringList.Create;
try
device_paths := TStringList.Create;
try
EnumerateDevicePaths(device_names, device_paths); // enumerate devices list, so we can use these later on to replace MS-DOS paths with mapped ones
phandles_size := HANDLE_BUFFER_INCREASE_CHUNK; // start with HANDLE_BUFFER_INCREASE_CHUNK value
phandles_info := AllocMem(phandles_size);
try
retcode := NtQuerySystemInformation(DWORD(SystemHandleInformation), phandles_info, phandles_size, nil);
while retcode = STATUS_INFO_LENGTH_MISMATCH do // realloc handles buffer memory until it's big enough to accept all handles data
begin
Inc(phandles_size, HANDLE_BUFFER_INCREASE_CHUNK);
ReallocMem(phandles_info, phandles_size);
retcode := NtQuerySystemInformation(DWORD(SystemHandleInformation), phandles_info, phandles_size, nil);
end;
if retcode <> STATUS_SUCCESS then
Exit(retcode);
// iterate through opened handles
for C1 := 0 to phandles_info^.HandleCount do
begin
phandle_info := pointer(Integer(#phandles_info^.Handles) + C1 * SizeOf(TSystemHandleInformation)); // get pointer to C1 handle info structure
// if ObjectType is not file, or if handle is named pipe (which would make Nt*() function to block), we skip to the next handle
// GrantedAccess mask here is very cryptic, I've been unable to find more information about it on Google, all codes use static hex numbers for check
if (phandle_info^.ObjectTypeNumber <> 28) or
(phandle_info^.GrantedAccess = $0012019F) or
(phandle_info^.GrantedAccess = $001A019F) or
(phandle_info^.GrantedAccess = $00120189) then
Continue;
process_handle := OpenProcess(PROCESS_DUP_HANDLE, FALSE, phandle_info^.ProcessId);
if process_handle <> 0 then
try
if DuplicateHandle(process_handle, phandle_info^.Handle, GetCurrentProcess, #dup_handle, 0, FALSE, 0) then
try
obj_name_size := SizeOf(TObjectNameInformation);
obj_name_info := AllocMem(obj_name_size);
try
// get path to the file
retcode := NtQueryObject(dup_handle, ObjectNameInformation, obj_name_info, obj_name_size, #obj_name_size);
if retcode <> STATUS_SUCCESS then
begin
ReallocMem(obj_name_info, obj_name_size);
retcode := NtQueryObject(dup_handle, ObjectNameInformation, obj_name_info, obj_name_size, nil);
end;
if retcode <> STATUS_SUCCESS then
Continue;
fname := obj_name_info^.Name.Buffer;
// replace MS-DOS device names with their mappings
for C2 := 0 to device_paths.Count - 1 do
if Copy(fname, 1, Length(device_paths[C2])) = device_paths[C2] then
begin
Delete(fname, 1, Length(device_paths[C2]));
fname := device_names[C2] + fname;
Break;
end;
// do necessary processing with fname here
WriteLn(phandle_info^.ProcessId, ': ', fname);
finally
FreeMem(obj_name_info, obj_name_size);
end;
finally
CloseHandle(dup_handle);
end;
finally
CloseHandle(process_handle);
end;
end;
finally
FreeMem(phandles_info, phandles_size);
end;
Exit(STATUS_SUCCESS);
finally
device_paths.Free;
end;
finally
device_names.Free;
end;
end;
begin
EnumerateOpenFiles;
Write('Done!');
ReadLn;
end.
This code can be improved in several more ways, but I gave you enough to start. For example, one of the optimizations would be to avoid opening same process multiple times by sorting handle list by PID, then opening process only once to check the handle group with those same PIDs.
It appears that you are using code from here: Delphi - get what files are opened by an application. This code claims to:
list all open handles from all processes
In other words it lists handles that are associated with objects other than file objects. The file names that you see that do not look like file names are indeed so. They are the names of objects other than files, to which the process has handles.

Resources