This question already has an answer here:
What are WinTypes, WinProcs and SW_NORMAL?
(1 answer)
Closed 4 years ago.
i can't execute my program in lazarus does the lazarus support the wintypes and winprocs
base.pas (2,13) Fatal: Can not find WinTypes used by eg the Project Inspector.
program ex;
uses Wincrt,WinTypes, WinProcs;
var
ch:string;
procedure exe (che:string);
begin
writeln('ecrire ch');
readln(che);
if ch ='oui' then
begin
WinExec('cmd /k "C:\TPW\exercice\project\site.html"', SW_NORMAL);
end;
end;
begin
exe(ch);
end.
WinExec function is obsolete. Use ShellExecute instead
program ex;
uses
Windows, // for constant SW_NORMAL
ShellApi; // for function ShellExecute
procedure exe;
var
che: string;
begin
writeln('ecrire ch');
readln(che);
if ch ='oui' then
begin
ShellExecute(0, 'open', 'C:\TPW\exercice\project\site.html', nil, nil, SW_NORMAL);
end;
end;
begin
exe;
end.
Related
This question already has answers here:
Delphi: Access Violation at the end of Create() constructor
(2 answers)
Closed 5 years ago.
It fails in this simple example to:
procedure TForm1.Button1Click(Sender: TObject);
var
ts: TStream;
begin
ts.Create; //<---- fails here
ts.Free;
end;
With error:
Project project1 raised exception class 'External: SIGSEGV'.
At address 10000DB38
You are using the wrong code. It should be
procedure TForm1.Button1Click(Sender: TObject);
var
ts: TStream;
begin
ts := TStream.Create; // If Lazarus supports creation of Stream instances.
ts.Free;
end;
Until it is created, your variable ts simply contains junk from previous use of the stack. You have to call the class's constructor to allocate the actual object on the heap and point your ts variable at it.
If Lazarus complains that it can't create an instance of TStream (it may treat it as an abstract class and I don't have Lazarus on this machine to check), try something like this instead:
var
ts: TMemoryStream;
begin
ts := TMemoryStream.Create;
ts.Free;
end;
Instead of TMemoryStream, you could use any other concrete TStream-descendant class.
Was originaly trying this code:
memStream.Create;
But it should be:
memStream := TMemoryStream.Create;
Blah...
I need to recognize and fire an event when a file is going to be executed or run by an application. I know I can do it by hooking windows procedures, but I don't know what procedure or event of windows fires.
For example, when an autorun file going to execute, my application should recognize it, Like an antivirus application.
I'm not sure that hooking is useful for my purpose, if solution isn't hooking, please give me a true solution.
try using the PsSetCreateProcessNotifyRoutine, this function adds a driver-supplied callback routine to, or removes it from, a list of routines to be called whenever a process is created or deleted.
you can find a very nice sample int this link written in c++
Detecting Windows NT/2K process execution
UPDATE
Another option is use the WMI events, check the Win32_Process class, the ExecNotificationQuery method and the SWbemEventSource.NextEvent function.
Check this sample tested in delphi 7 and Windows 7, you must run this application from outside of the Delphi IDE or disable the exception notification for the EOleException exception (check this link), to avoid the EOleException wich is intercepted by the IDE.
program GetWMI_InstanceCreationEvent;
{$APPTYPE CONSOLE}
uses
SysUtils
,Windows
,ComObj
,ActiveX
,Variants;
Function KeyPressed:boolean; //detect if an key is pressed
var
NumEvents : DWORD;
ir : _INPUT_RECORD;
bufcount : DWORD;
StdIn : THandle;
begin
Result:=false;
StdIn := GetStdHandle(STD_INPUT_HANDLE);
NumEvents:=0;
GetNumberOfConsoleInputEvents(StdIn,NumEvents);
if NumEvents<> 0 then
begin
PeekConsoleInput(StdIn,ir,1,bufcount);
if bufcount <> 0 then
begin
if ir.EventType = KEY_EVENT then
begin
if ir.Event.KeyEvent.bKeyDown then
result:=true
else
FlushConsoleInputBuffer(StdIn);
end
else
FlushConsoleInputBuffer(StdIn);
end;
end;
end;
function VarStrNUll(VarStr:OleVariant):string;//dummy function to handle null variants
begin
Result:='';
if not VarIsNull(VarStr) then
Result:=VarToStr(VarStr);
end;
function GetWMIObject(const objectName: String): IDispatch; //create a wmi object instance
var
chEaten: Integer;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
Procedure GetWin32_InstanceCreationEvent;
var
objWMIService : OLEVariant;
colMonitoredProcesses : OLEVariant;
objLatestProcess : OLEVariant;
begin
objWMIService := GetWMIObject('winmgmts:\\localhost\root\cimv2');
colMonitoredProcesses := objWMIService.ExecNotificationQuery('Select * From __InstanceCreationEvent Within 1 Where TargetInstance ISA ''Win32_Process'''); //Get the event listener
while not KeyPressed do
begin
try
objLatestProcess := colMonitoredProcesses.NextEvent(100);//set the max time to wait (ms)
except
on E:EOleException do
if EOleException(E).ErrorCode=HRESULT($80043001) then //Check for the timeout error wbemErrTimedOut 0x80043001
objLatestProcess:=Null
else
raise;
end;
if not VarIsNull(objLatestProcess) then
begin
Writeln('Process Started '+VarStrNUll(objLatestProcess.TargetInstance.Name));
Writeln('CommandLine '+VarStrNUll(objLatestProcess.TargetInstance.CommandLine));
Writeln('PID '+VarStrNUll(objLatestProcess.TargetInstance.ProcessID));
end;
end;
end;
begin
try
CoInitialize(nil);
try
Writeln('Press Any key to exit');
GetWin32_InstanceCreationEvent;
finally
CoUninitialize;
end;
except
on E:Exception do
Begin
Writeln(E.Classname, ': ', E.Message);
Readln;
End;
end;
end.
I want to capture cmd.exe output and show it in a diffrent gui I am making. I want to make a command interpreter with extended functionality. The dir command works flawless, the problem ocurrs when I try to execute another process like ipconfig.
I don't see ipconfig output. Is there a workarround on that ?!
I use TProcess component from Lazarus (FreePascal)
proc := TProcess.Create(nil);
proc.Options:= [poUsePipes, poNoConsole];
proc.ShowWindow:= swoHIDE;
proc.Executable:= 'cmd';
Reading output thread:
if (Length(cmd) > 0) then
begin
cmd := cmd + #13#10;
proc.Input.Write(cmd[1], Length(cmd)); // here I write command from user
strikes := 0;
end
else
if proc.Output.NumBytesAvailable > 0 then
begin
while proc.Output.NumBytesAvailable > 0 do
begin
FillChar(buf, sizeof(buf), #0);
proc.Output.Read(buf, sizeof(buf) - 1);
data := data + buf;
end;
// data gets echoed to user
It works fine for me (I use FPC 3.1.1 & Lazarus 1.5 but I hope it does not matter):
proc.Options:= [poUsePipes];
proc.ShowWindow:= swoHIDE;
proc.Executable:= 'cmd';
...
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
cmd: String;
begin
if Key = #13 then
begin
Key := #0;
if not proc.Active then
proc.Active := True;
cmd := Edit1.Text + LineEnding;
proc.Input.Write(cmd[1], Length(cmd));
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
buf: array[0..65535] of Char;
begin
if proc.Output.NumBytesAvailable > 0 then
begin
while proc.Output.NumBytesAvailable > 0 do
begin
FillChar(buf, sizeof(buf), #0);
proc.Output.Read(buf, sizeof(buf) - 1);
Memo1.Lines.Add(buf);
end;
end;
end;
I guess that you just does not catch process output properly.
Good luck.
PS: If you need to create some windows console-like application, the best way, I think, is using Windows console API instead of cross-platform Lazarus components.
PPS: To emulate console look and behavior with Lazarus use CmdLine component.
In general it is smart to first check if the short examples don't solve the problem:
e.g.
uses process;
var s : ansistring;
begin
runcommand('ipconfig',['/all'],s);
writeln(s);
end.
works fine, and saves a whole lot of trouble. (FPC 2.6.2+ though)
function GetFileIcon(const filename:string): HICON;
var
shfi: TShFileInfo;
begin
try
FillChar(shfi, SizeOf(TShFileInfo), 0);
ShGetFileInfo(PChar(filename), 0, shfi, SizeOf(TShFileInfo), SHGFI_ICON or SHGFI_LARGEICON);
Result := shfi.hIcon;
except
Result := 0;
end;
end;
Using delphi xe2, on win 7 64bits, this function will often return 0 when called inside a Tthread, but is always working fine when called from main thread. It looks like a shell initialization problem, because after a while it will work in the Thread as well.
I found a similar question in stack overflow (Calling SHGetFileInfo in thread to avoid UI freeze) but it is for c++ language so I did not sort it out.
Update: It seems ShGetFileInfo is not threadsafe. When there are multiple threads calling it simultaneously, it fails. See David
Hefferman's answer below. Also using CoInitializeEx instead of Coinitialize does not help with multiple threads. You have to serilize access using a TCriticalSection.
From the documentation:
You must initialize Component Object Model (COM) with CoInitialize or OleInitialize prior to calling SHGetFileInfo.
In a GUI app, the COM is initialized in the main thread. But from other threads that does not happen automatically. You will need to do it explicitly.
Beyond that you are not handling errors correctly. Remember that Windows API functions do not raise exceptions. So your exception handler is pointless and should be removed. Instead you need to check the return value of your call to SHGetFileInfo, as described in the documentation.
Beyond that your code works, as this program demonstrates:
{$APPTYPE CONSOLE}
uses
Classes, Windows, ActiveX, ShellAPI;
var
hThread: THandle;
ThreadId: Cardinal;
function ThreadFunc(Parameter: Pointer): Integer;
var
shfi: TSHFileInfo;
begin
CoInitialize(nil);
Try
if ShGetFileInfo('C:\windows\explorer.exe', 0, shfi, SizeOf(shfi), SHGFI_ICON or SHGFI_LARGEICON)=0 then
begin
Writeln('ShGetFileInfo Failed');
Result := 1;
exit;
end;
Writeln(shfi.hIcon);
Finally
CoUninitialize;
End;
Result := 0;
end;
begin
hThread := BeginThread(nil, 0, ThreadFunc, nil, 0, ThreadId);
WaitForSingleObject(hThread, INFINITE);
CloseHandle(hThread);
Readln;
end.
I expect that any failure you observe is actually related to the particular file that you are trying to inspect.
Update: It seems ShGetFileInfo is not threadsafe. When there are multiple threads calling it simultaneously, it fails. I believe that you will need to serialize the calls to ShGetFileInfo with a lock. For instance, TCriticalSection.
The following program, based on the SSCCE you provided in the comments, demonstrates this:
{$APPTYPE CONSOLE}
uses
SysUtils,
Classes,
SyncObjs,
Windows,
ActiveX,
ShellAPI;
var
hThreads: TWOHandleArray;
ThreadId: Cardinal;
Lock: TCriticalSection;
function ThreadFunc(Parameter: Pointer): Integer;
var
shfi: TSHFileInfo;
randomnumber: integer;
fname: string;
begin
CoInitialize(nil);
Try
fname := 'c:\desktop\file'+IntToStr(Integer(Parameter))+'.exe';
Lock.Acquire;
try
if ShGetFileInfo(pchar(fname), 0, shfi, SizeOf(shfi), SHGFI_ICON or SHGFI_LARGEICON)=0 then
begin
Writeln('ShGetFileInfo Failed');
Result := 1;
exit;
end;
Writeln(shfi.hIcon);
finally
Lock.Release;
end;
Finally
CoUninitialize;
End;
Result := 0;
end;
var
i: integer;
begin
Lock := TCriticalSection.Create;
for i := 0 to 9 do
hThreads[i] := BeginThread(nil, 0, ThreadFunc, Pointer(i), 0, ThreadId);
WaitForMultipleObjects(10, #hThreads,true, INFINITE);
Readln;
end.
Remove the critical section, and the calls to ShGetFileInfo succeed, but return 0 for the icon handle. With the critical section, valid icon handles are returned.
I need to recognize and fire an event when a file is going to be executed or run by an application. I know I can do it by hooking windows procedures, but I don't know what procedure or event of windows fires.
For example, when an autorun file going to execute, my application should recognize it, Like an antivirus application.
I'm not sure that hooking is useful for my purpose, if solution isn't hooking, please give me a true solution.
try using the PsSetCreateProcessNotifyRoutine, this function adds a driver-supplied callback routine to, or removes it from, a list of routines to be called whenever a process is created or deleted.
you can find a very nice sample int this link written in c++
Detecting Windows NT/2K process execution
UPDATE
Another option is use the WMI events, check the Win32_Process class, the ExecNotificationQuery method and the SWbemEventSource.NextEvent function.
Check this sample tested in delphi 7 and Windows 7, you must run this application from outside of the Delphi IDE or disable the exception notification for the EOleException exception (check this link), to avoid the EOleException wich is intercepted by the IDE.
program GetWMI_InstanceCreationEvent;
{$APPTYPE CONSOLE}
uses
SysUtils
,Windows
,ComObj
,ActiveX
,Variants;
Function KeyPressed:boolean; //detect if an key is pressed
var
NumEvents : DWORD;
ir : _INPUT_RECORD;
bufcount : DWORD;
StdIn : THandle;
begin
Result:=false;
StdIn := GetStdHandle(STD_INPUT_HANDLE);
NumEvents:=0;
GetNumberOfConsoleInputEvents(StdIn,NumEvents);
if NumEvents<> 0 then
begin
PeekConsoleInput(StdIn,ir,1,bufcount);
if bufcount <> 0 then
begin
if ir.EventType = KEY_EVENT then
begin
if ir.Event.KeyEvent.bKeyDown then
result:=true
else
FlushConsoleInputBuffer(StdIn);
end
else
FlushConsoleInputBuffer(StdIn);
end;
end;
end;
function VarStrNUll(VarStr:OleVariant):string;//dummy function to handle null variants
begin
Result:='';
if not VarIsNull(VarStr) then
Result:=VarToStr(VarStr);
end;
function GetWMIObject(const objectName: String): IDispatch; //create a wmi object instance
var
chEaten: Integer;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
Procedure GetWin32_InstanceCreationEvent;
var
objWMIService : OLEVariant;
colMonitoredProcesses : OLEVariant;
objLatestProcess : OLEVariant;
begin
objWMIService := GetWMIObject('winmgmts:\\localhost\root\cimv2');
colMonitoredProcesses := objWMIService.ExecNotificationQuery('Select * From __InstanceCreationEvent Within 1 Where TargetInstance ISA ''Win32_Process'''); //Get the event listener
while not KeyPressed do
begin
try
objLatestProcess := colMonitoredProcesses.NextEvent(100);//set the max time to wait (ms)
except
on E:EOleException do
if EOleException(E).ErrorCode=HRESULT($80043001) then //Check for the timeout error wbemErrTimedOut 0x80043001
objLatestProcess:=Null
else
raise;
end;
if not VarIsNull(objLatestProcess) then
begin
Writeln('Process Started '+VarStrNUll(objLatestProcess.TargetInstance.Name));
Writeln('CommandLine '+VarStrNUll(objLatestProcess.TargetInstance.CommandLine));
Writeln('PID '+VarStrNUll(objLatestProcess.TargetInstance.ProcessID));
end;
end;
end;
begin
try
CoInitialize(nil);
try
Writeln('Press Any key to exit');
GetWin32_InstanceCreationEvent;
finally
CoUninitialize;
end;
except
on E:Exception do
Begin
Writeln(E.Classname, ': ', E.Message);
Readln;
End;
end;
end.