I'm making a simple snmp application on raspberry pi use indy with freepascal.
I can ping to device and send get/set request via mibbrowser but this doesn't work, send query always fail.
program snmptest;
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
uses
sysutils, IdSNMP, IdUDPBase, IdUDPClient;
var
snmp:tidsnmp;
s,mib:string;
begin
mib:='1.3.6.1.4.1.6247.32.1.2.12.0';
snmp:=tidsnmp.create(nil);
try
snmp.host:='172.16.1.222';
snmp.community:='public';
snmp.query.clear;
snmp.query.pdutype:=pdugetrequest;
snmp.query.mibadd(mib,'');
if snmp.sendquery then
begin
s:=snmp.reply.mibget(mib);
writeln(s);
end
else begin
writeln('fail!');
end;
finally
snmp.free;
end;
end.
Related
I write a basic Delphi MS-Windows service.
I install it with the /install directove. This works.
In the Windows Services list it exists.
I START it from there. Windows says it started successfully. It shows as running.
But nothing is executed, except the OnCreate and OnDestroy.
It is in fact NOT running, while Windows claims it IS running.
I tried Delpi 10.2 and the latest 10.4.
What is going wrong here? It is the most basic Service possible.
The Log output looks like this:
Create
AfterInstall
Destroy
Create
Destroy
Create
Destroy
program BartServiceTwo;
uses
Vcl.SvcMgr,
Unit1 in 'Unit1.pas' {BartService: TService};
{$R *.RES}
begin
// Windows 2003 Server requires StartServiceCtrlDispatcher to be
// called before CoRegisterClassObject, which can be called indirectly
// by Application.Initialize. TServiceApplication.DelayInitialize allows
// Application.Initialize to be called from TService.Main (after
// StartServiceCtrlDispatcher has been called).
//
// Delayed initialization of the Application object may affect
// events which then occur prior to initialization, such as
// TService.OnCreate. It is only recommended if the ServiceApplication
// registers a class object with OLE and is intended for use with
// Windows 2003 Server.
//
// Application.DelayInitialize := True;
//
if not Application.DelayInitialize or Application.Installing then
Application.Initialize;
Application.CreateForm(TBartService, BartService);
Application.Run;
end.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.SvcMgr;
type
TBartService = class(TService)
procedure ServiceExecute(Sender: TService);
procedure ServiceCreate(Sender: TObject);
procedure ServiceDestroy(Sender: TObject);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceAfterInstall(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
procedure Log(Line:string);
{ Public declarations }
end;
var
BartService: TBartService;
LogFile: text;
Logfilename: string;
implementation
{$R *.dfm}
procedure TBartService.Log(Line:string);
begin
if Logfilename = '' then
begin
Logfilename := 'Log.txt';
Assignfile(LogFile,Logfilename);
end;
try
if FileExists(Logfilename)
then append(LogFile)
else rewrite(LogFile);
writeln(LogFile,line);
Closefile(LogFile);
except
on E:Exception do;
end;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
BartService.Controller(CtrlCode);
end;
function TBartService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TBartService.ServiceAfterInstall(Sender: TService);
begin
Log('AfterInstall');
end;
procedure TBartService.ServiceCreate(Sender: TObject);
begin
Log('Create');
messagebeep(0);
end;
procedure TBartService.ServiceDestroy(Sender: TObject);
begin
Log('Destroy');
end;
procedure TBartService.ServiceExecute(Sender: TService);
begin
Log('ServiceExecute Start. Terminated='+Terminated.ToString(true));
while not Terminated do
begin
try
ServiceThread.ProcessRequests(false);
Log('ServiceExecute');
// messagebeep(0);
sleep(1000);
except
on E:Exception do
begin
Log('ERROR: ServiceExecute: Final: '+E.Message);
end;
end;
end;
Log('ServiceExecute Out of loop.');
end;
procedure TBartService.ServiceStart(Sender: TService; var Started: Boolean);
begin
Log('ServiceStart');
end;
procedure TBartService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
Log('ServiceStop');
end;
end.
I assume that during your debugging you have copy and pasted code into the unit from another project but you have not 'hooked up' the events properly. Bring up the project in Delphi and open the service module. Click on the Events tab in the Object Inspector and my guess is that they are all blank. (View the source of the .dfm and there is likely no OnExecute, OnStop, OnStop, etc events defined)
For example - double click the OnExecute event and I assume the IDE will automatically create a new OnExecute event rather than navigating to your OnExecute event in the unit.
Simply rehook up your events and it will most likely work as expected.
Solved. After using the 'LogMessage() system, I found that the service is in fact running.
But what happened, is that the destination folder of my simple Log file was transfered from the local executable directory to C:\Windows\System32\ and there was all the rest of the Log data... I never expected that :(
Thanks for all help, Bart
I have trouble displaying RTF-Formatted text between two delphi-Versions.
The TDBRichEdit-Control and TRichEdit-Control seem to have trouble parsing the RTF-text supplied.
Sometimes it seems as if to get it to work in XE8 you simply have to connect a TDBRichEdit to the appropriate Field in the Dataset, but the same Method would mess up the Delphi 7 Version.
So we figured we handle this via Code.
Basically we replaced the TDBRichEdits with normal TRichEdits and
supply the RTF through a stream.
textstream:=TStringStream.Create(CDS.FieldByName('TEXT').AsString);
try
RichEditFAPLAN.Lines.Clear();
RichEditFAPLAN.Lines.LoadFromStream(textStream);
finally
textstream.Free();
end;
this worked fine until about 1h ago when I decided to move the code above into it's own globally available function.
procedure StreamRichTextTo(ARichEdit:TCustomRichEdit; ADataSet:TDataSet; AFieldName:String);
var
ws:WideString;
Stream:TStringStream;
begin
ARichEdit.Lines.Clear();
if (ADataSet=nil) or (ADataSet.FindField(AFieldName)=nil) or (ADataSet.FieldByName(AFieldName).IsNull) then exit;
ws:=UTF8Decode(ADataSet.FieldByName(AFieldName).AsString);
Stream:=TStringStream.Create(ws);
try
Stream.Position:=0;
ARichEdit.Lines.LoadFromStream(Stream);
finally
Stream.Free();
end;
end;
I tried different Variations of this code. With MemoryStream, Widestring, UTF8 Encoding, AnsiString and what not.
procedure StreamRichTextTo(ARichEdit:TCustomRichEdit; ADataSet:TDataSet; AFieldName:String);
var
{$IFDEF VER150}
ws:WideString;
Stream:TStringStream;
{$ELSE}
s:AnsiString;
//Stream:TMemoryStream;
Stream:TStringStream;
{$ENDIF}
begin
ARichEdit.Lines.Clear();
if (ADataSet=nil) or (ADataSet.FindField(AFieldName)=nil) or (ADataSet.FieldByName(AFieldName).IsNull) then exit;
{$IFDEF VER150}
ws:=UTF8Decode(ADataSet.FieldByName(AFieldName).AsString);
Stream:=TStringStream.Create(ws);
{$ELSE}
{
s:=ADataSet.FieldByName(AFieldName).AsAnsiString;
Stream:=TMemoryStream.Create();
Stream.Clear();
Stream.Write(PAnsiChar(s)^,length(s));
}
s:=ADataSet.FieldByName(AFieldName).AsAnsiString;
Stream:=TStringStream.Create(s,TEncoding.UTF8);
//Stream.WriteString(s);
Stream.Position:=0;
{$ENDIF}
try
ARichEdit.Lines.LoadFromStream(Stream);
finally
Stream.Free();
end;
end;
All to no avail, the XE-RTF-Text always comes out looking either like this or as a simple '':
{\rtf1\fbidis\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 arial;}{\f1\fswiss\fprq2\fcharset0 Arial;}{\f2\fnil arial;}}
\viewkind4\uc1\pard\ltrpar\lang1031\f0\fs20 Gie\'dftemp.: \tab 1350 - 1370 \'b0C
\par \ul\f1 Form fest verklammern und belasten
\par \ulnone\f0
\par \tab\tab\f2
\par }
What's more, the original Code with the "textstream", that I commented back in, is also not working anymore.
What I'm looking for is a code-solution that can properly handle RTF-Text between different IDE-Versions.
EDIT:
Here is a sample Project-Code.
The thing is, everything works fine in this project.
I have no idea why the same code does no longer work in our software and I can not reproduce it.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Data.DB,
Datasnap.DBClient;
type
TForm1 = class(TForm)
REGoal: TRichEdit;
Button1: TButton;
CDS: TClientDataSet;
RESource: TRichEdit;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure StreamRichTextTo(ARichEdit:TRichEdit; ADataSet:TDataSet; AFieldName:String);
var
Stream:TStringStream;
//{$IFDEF VER150}
ws:WideString;
//{$ELSE}
//{$ENDIF}
begin
ARichEdit.Lines.Clear();
if (ADataSet=nil) or (ADataSet.FindField(AFieldName)=nil) or (ADataSet.FieldByName(AFieldName).IsNull) then exit;
try
//{$IFDEF VER150}
ws:=UTF8Decode(ADataSet.FieldByName(AFieldName).AsString);
Stream:=TStringStream.Create(ws);
//{$ELSE}
// Stream:=TStringStream.Create(ADataSet.FieldByName(AFieldName).AsString);
//{$ENDIF}
ARichEdit.Lines.LoadFromStream(Stream);
finally
Stream.Free();
end;
end;
(* Copy this to RESource
{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 arial;}{\f1\fnil arial;}}
\viewkind4\uc1\pard\lang1031\f0\fs20 Erste Form ist eine Zulegekontrolle durchzuf\fchren.
\par
\par
\par \f1
\par }
*)
procedure TForm1.Button1Click(Sender: TObject);
var
Stream:TStringStream;
begin
if CDS.FindField('TEXT')=nil then
begin
CDS.FieldDefs.Add('TEXT',ftWideString,4096);
CDS.CreateDataSet();
end;
CDS.Edit();
CDS.FieldByName('TEXT').AsString:=RESource.text;
CDS.Post();
StreamRichTextTo(REGoal,CDS,'TEXT');
end;
Just Create a new Form1
Add 2 TRichEdits, one is called RESource and the other REGoal
Add a TClientDataSet and call it CDS
Add A Button
Assign the OnClick-procedure to the button
I'll try creating the project in D7 and port it to XE8 next, maybe this will reproduce the effect.
EDIT 2:
Creating the Project in Delphi 7 and then Opening it in XE8 produces the same result.
My guess is, that there is something happening when the Database-Value is assigned to a String-Variable (or passed directly into the stream) which would be why I'm unable to reproduce the error.
Also maybe the Database is at fault.
it's a Firebird 3.0 Database with a VarChar-Field
This IS the working Version of the code.
Apparently there was something wrong with the RTF-Code itself due to a bug in our Editor
procedure StreamRichTextTo(ARichEdit:TRichEdit; ADataSet:TDataSet; AFieldName:String);
var
{$IFDEF VER150}
ws:WideString;
{$ELSE}
ws:String;
{$ENDIF}
Stream:TStringStream;
begin
ARichEdit.Lines.Clear();
if (ADataSet=nil) or (ADataSet.FindField(AFieldName)=nil) or (ADataSet.FieldByName(AFieldName).IsNull) then exit;
{$IFDEF VER150}
ws:=UTF8Decode(ADataSet.FieldByName(AFieldName).AsString);
{$ELSE}
ws:=ADataSet.FieldByName(AFieldName).AsString;
{$ENDIF}
Stream:=TStringStream.Create(ws);
try
ARichEdit.Lines.LoadFromStream(Stream);
finally
Stream.Free();
end;
end;
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.
First go at starting my own service in Delphi 7. Followed the docs and made the service spawn a custom thread that beeps and logs. Only it doesn't. Last attempt was to put the same beep and log code in OnExecute event procedure, but when I start the service I get a Windows dialog saying that it was started and then stopped again.
There should be something obvious that I've overlooked in this code.
Could you have a look? I'll also accept links to simple, working, downloadable service example projects... just so I get something that is called every 10 seconds or so and I'll take it from there.
A bare bones service application follows.
Please note that if you want to install the service on Windows Vista and higher using ServiceApp.exe /install, you will have to ensure that you are running the app with administrator rights.
Also note that despite the fmShareDenyWrite the contents of the log file may not be viewable while the service is running. At least I couldn't open the file using Notepad++ until after I stopped the service. This may have to do with the fact that I had the service running under the system account (as opposed to my own user account).
One other remark:
If you want to allow your service to be paused and continued, don't use suspend and resume. They are not thread safe and have been deprecated in D2010+. Using T(Simple)Event or something similar to control the main worker thread's execution.
If you do not want to allow your service to be paused and continued, you can simply set AllowPause to False.
unit ServiceApp_fm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;
type
TService1 = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
private
FWorker: TThread;
public
function GetServiceController: TServiceController; override;
end;
var
Service1: TService1;
implementation
{$R *.DFM}
type
TMainWorkThread = class(TThread)
private
{$IFDEF UNICODE}
FLog: TStreamWriter;
{$ELSE}
FLog: TFileStream;
{$ENDIF}
FRepetition: Cardinal;
public
constructor Create;
destructor Destroy; override;
procedure Execute; override;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;
function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
FWorker := TMainWorkThread.Create;
Started := True;
end;
procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
// Thread should be freed as well as terminated so we don't have a memory
// leak. Use FreeAndNil so we can also recognize when the thread isn't
// available. (When the service has been stopped but the process hasn't ended
// yet or may not even end when the service is restarted instead of "just" stopped.
if FWorker <> nil then
begin
FWorker.Terminate;
while WaitForSingleObject(FWorker.Handle, WaitHint-100) = WAIT_TIMEOUT do
ReportStatus;
FreeAndNil(FWorker);
end;
Stopped := True;
end;
{ TMainWorkThread }
constructor TMainWorkThread.Create;
var
FileName: String;
begin
inherited Create({CreateSuspended=}False);
FileName := ExtractFilePath(ParamStr(0)) + '\WorkerLog.txt';
{$IFDEF UNICODE}
FLog := TStreamWriter.Create(FileName, False, TEncoding.Unicode);
{$ELSE}
FLog := TFileStream.Create(FileName, fmCreate);
{$ENDIF}
end;
destructor TMainWorkThread.Destroy;
begin
FLog.Free;
inherited;
end;
procedure TMainWorkThread.Execute;
var
Text: string;
begin
inherited;
while not Terminated do begin
Inc(FRepetition);
Text := Format('Logging repetition %d'#13#10, [FRepetition]);
{$IFDEF UNICODE}
FLog.Write(Text);
{$ELSE}
FLog.Write(Text[1], Length(Text));
{$ENDIF}
Sleep(1000);
end;
end;
end.
Please have a look at http://www.delphi3000.com/articles/article_3379.asp for details on creating a service. I made that post years ago, but should still work.
Remove below method event
procedure TAviaABSwedenAMailer.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
Beep;
Sleep(500);
LG('Amailer is running');
ServiceThread.ProcessRequests(False);
end;
end;
The beep will not work, see this post.
Your procedure LG is not verry robust it may fail if the log file doesn't exist. Also the service user must have the right to access the file. In a first step you can run the service with your user account for testing.
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.