Delphi 10.4 ISAPI Printer.Handle - delphi

I created a very simple ISAPI DLL with the following code on the default handler:
procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
DevHandle : THandle;
begin
Printer.PrinterIndex := 0;
DevHandle := Printer.Handle;
end;
The second line always fails with "Printer Selected is not Valid." I originally thought this might be a rights issue, but have tried identities with adequate rights. Additionally, the Printer class does return the correct list of printers/drivers matching those installed on my machine.
Is there a way around this error so the default printer can be selected and I can retrieve the printer handle?

I am not sure it is safe to print from ISAPI dll , it may hang and several client can try to access at the same time.
what i have done :
ISAPI request write on local database what it wanted to print , then display an animation at client side while it waits for an external software to finish the job.
not sure it helps ..

Related

Delphi Datasnap client code not getting unauthorized exception

I'm using Delphi 10.1 Berlin Update 2 Enterprise and the DataSnap client/server REST framework.
If I run the app without debugging and invoke a method the user isn't authorized to invoke, the code runs without any exception and the method returns a null response.
When interactively debugging a call on the client to a DataSnap server method, I get two popup exceptions regarding "unauthorized".
The first bubbles up and is replaced by the second.
The second exception gets "eaten" and the session/connection simply closed and then the method returns a blank result (e.g. a zero if the return type is integer, and an empty string for a string return type).
This is happening in the following section of code near the end of the ExecuteRequest method in the Datasnap.DSClientRest unit:
except
on E: TDSRestProtocolException do
LSessionExpired;
end;
Why are these exceptions (e.g. TDSRestProtocolException) not reaching my code?
I kind of think this is new to Update 2, and I remember seeing those exceptions bubble up to my code prior to Update 2.
Attached is a skeleton example (standard example generated by Delphi wizards) that demonstrates the issue - click the button and you get "" instead of "4321" because the user isn't authorized - but no runtime exception.
I'm new to DataSnap, so bear with me :-)
Thanks in advance for helpful responses =)
This is happening due to DSAuthenticationManager1 component added to webmodule of the server and client side is failing to authenticate.
Please go through this to check how to work with authentication
Adding Authentication and Authorization
Well..I'm not sure but try providing username and password to DSRestConnection1 component before the instance of server methods gets created
procedure TClientModule1.TestCon(aUsername, aPassword: string);
var
lServerMethodsClient : TServerMethodsClient;
begin
DSRestConnection1.UserName := aUsername;
DSRestConnection1.Password := aPassword;
lServerMethodsClient:=TServerMethodsClient.Create(DSRestConnection1);
end;
and try to call this functn from ur clientform
procedure TF_ClientForm.Button1Click(Sender: TObject);
begin
ClientModule1.TestCon(EdtUsername.Text, EdtPassword.Text);
end;
Maybe a little late but this morning I've had a deep dive into this because, after upgrading from Delphi XE6 to Tokyo 10.2, applications where I used the TDSRestConnection component got broken. Although I supplied the correct username and password, they did not appear in the TDSAuthenticationManager.OnUserAuthenticate event.
The 'problem' has to do with the new System.Net.HttpClient implementation.
To make a long story short (or a little bit less long):
The client component does not send the credentials until the receiving server demands one by sending a 401 response. After receiving this (properly formatted) response the client looks at de TDSConnection credentials en tries again. At the client side a complete list of urls with credential requirements is maintaned so repetitive calls to the same url go 'smoother'.
I added this code to the server's WebModule (where the TDSRESTWebDispatcher resides) which solved my problems:
procedure TwbmMain.WebModuleBeforeDispatch(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
LAuthorization: string;
begin
inherited;
if Request.PathInfo.StartsWith('/datasnap/') then
begin
LAuthorization := TNetEncoding.Base64.Decode(Request.Authorization.Replace('Basic ', ''));
if LAuthorization.IsEmpty then
begin
Response.StatusCode := 401;
Response.WWWAuthenticate := 'Basic';
Handled := True;
end;
end;
end;
Because my applications provides some downloadable items like a logo etc., I limited the check to just those URLs that have anything to do with datasnap.
Hope this is useful to others!

Fault in Ole Automation Server

I set up an OLE Automation Server and an OLE Client in Delphi XE2. My two Methods are the following:
function TMyCom2.Get_Text() : IStrings;
begin
GetOleStrings(unit1.Form1.Memo1.Lines, Result);
end;
and:
procedure TMyCom2.Set_Text(const value: IStrings);
begin
SetOleStrings(unit1.Form1.Memo1.Lines, value);
end;
Now I tried to call both by the client.
The second Method(Set_Text) was working perfectly fine.
But the first one(Get_Text) wich should gather the content of the memo of the server and write it into the memo of the client, caused this exception:
Exception error of the server!
To get the Ole information I wrote this on the client side:
procedure TForm1.Button1Click(Sender: TObject);
var
aStrings : IStrings;
begin
aStrings.Add(Server.Get_Text);
SetOleStrings(Memo1.Lines, aStrings);
end;
I have no idea what could be wrong and I was incredibly grateful if somebody could take a look at this code and tell me what the hell is going wrong;D
PS: I already tested it with Integers and it worked so the Problem has to do something with Strings
I uploaded the two projects on Dropbox so feel free to download them:
Client: here
Server: here

Reading image data from client using Indy command handler

I have a small client-server application project using Indy 9. My server application is using 'command handler' to handle client's command.
In this case my client application using writeLn procedure to send command and data, which is text based. For example:
IdTcpClient1.WriteLn('cmd1'+'#'+'hello server');
note: 'cmd1' is a command, '#' is command delimiter, and 'hello server' is the data
In order to handle this command (cmd1), my server application has a procedure as follows:
procedure TForm1.IdTcpServer1cmd1Command(Asender:TIdCommand);
var
s: string;
begin
if ( Assigned(ASender.Params) ) then
begin
s:= Asender.Param[0];
...............
...............
end;
end;
So far everything is fine. The problem is that I want to add a feature so that my server application is able to request and receive a JPEG_image from client. If client send this image using: WriteStream procedure, for example:
IdTcpClient1.WriteStream(MyImageStream);
How then the the server handle this event considering that there is no specific command to it (such as 'cmd1' in this example)?
You would simply call ReadStream() in the command handler, eg:
IdTcpClient1.WriteLn('JPEG');
IdTcpClient1.WriteStream(MyImageStream, True, True); // AWriteByteCount=True
procedure TForm1.IdTcpServer1JPEGCommand(ASender: TIdCommand);
var
Strm: TMemoryStream;
begin
...
Strm := TMemoryStream.Create;
try
ASender.Thread.Connection.ReadStream(Strm); // expects AWriteByteCount=True by default
...
finally
Strm.Free;
end;
...
end;
Alternatively:
IdTcpClient1.WriteLn('JPEG#' + IntToStr(MyImageStream.Size));
IdTcpClient1.WriteStream(MyImageStream); // AWriteByteCount=False
procedure TForm1.IdTcpServer1JPEGCommand(ASender: TIdCommand);
var
Size: Integer;
Strm: TMemoryStream;
begin
...
Size := StrToInt(ASender.Params[0]);
Strm := TMemoryStream.Create;
try
if Size > 0 then
ASender.Thread.Connection.ReadStream(Strm, Size, False); // AWriteByteCount=True not expected
...
finally
Strm.Free;
end;
...
end;
How then the the server handle this event
So what is you actually want to learn ? What is your actual question ?
If you want to know how your server would behave - then just run your program and see what happens.
If you want to know how to design your server and client, so client could upload a picture to server - then ask just that.
I think that the proper thing to do would be adding the command "picture-upload" with two parameters: an integer token and a jpeg stream.
When the server would reply to cmd1 command, if it would need, it would generate and attach a unique integer token, asking the client to upload the screenshot.
When client would receive this reply, it would parse it, and if the token would be found - would issue one more command, a specially designed "picture-upload#12345" (where 12345 replaced with actual token value) followed by the picture itself. The server would then use the token value to know which client and why did the upload.
PS. though personally I think you'd better just use standardized HTTP REST rather than making your own incompatible protocol.

Preventing multiple instances - but also handle the command line parameters?

I am handling from my Application associated extension files from Windows. So when you double click a file from Windows it will execute my program, and I handle the file from there, something like:
procedure TMainForm.FormCreate(Sender: TObject);
var
i: Integer;
begin
for i := 0 to ParamCount -1 do
begin
if SameText(ExtractFileExt(ParamStr(i)), '.ext1') then
begin
// handle my file..
// break if needed
end else
if SameText(ExtractFileExt(ParamStr(i)), '.ext2') then
begin
// handle my file..
// break if needed
end else
end;
end;
That works pretty much how I want it to, but when I was testing I realised it does not consider using only one instance of my program.
So for example, if I selected several Files from Windows and opened them all at the same time, this will create the same number of instances of my program with the number of Files being opened.
What would be a good way to approach this, so that instead of several instances of my program being opened, any additional Files from Windows being opened will simply focus back to the one and only instance, and I handle the Files as normal?
Thanks
UPDATE
I found a good article here: http://www.delphidabbler.com/articles?article=13&part=2 which I think is what I need, and shows how to work with the Windows API as mentioned by rhooligan. I am going to read through it now..
Here is some simple example code that gets the job done. I hope it is self-explanatory.
program StartupProject;
uses
SysUtils,
Messages,
Windows,
Forms,
uMainForm in 'uMainForm.pas' {MainForm};
{$R *.res}
procedure Main;
var
i: Integer;
Arg: string;
Window: HWND;
CopyDataStruct: TCopyDataStruct;
begin
Window := FindWindow(SWindowClassName, nil);
if Window=0 then begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end else begin
FillChar(CopyDataStruct, Sizeof(CopyDataStruct), 0);
for i := 1 to ParamCount do begin
Arg := ParamStr(i);
CopyDataStruct.cbData := (Length(Arg)+1)*SizeOf(Char);
CopyDataStruct.lpData := PChar(Arg);
SendMessage(Window, WM_COPYDATA, 0, NativeInt(#CopyDataStruct));
end;
SetForegroundWindow(Window);
end;
end;
begin
Main;
end.
unit uMainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;
type
TMainForm = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure WMCopyData(var Message: TWMCopyData); message WM_COPYDATA;
public
procedure ProcessArgument(const Arg: string);
end;
var
MainForm: TMainForm;
const
SWindowClassName = 'VeryUniqueNameToAvoidUnexpectedCollisions';
implementation
{$R *.dfm}
{ TMainForm }
procedure TMainForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.WinClassName := SWindowClassName;
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
i: Integer;
begin
for i := 1 to ParamCount do begin
ProcessArgument(ParamStr(i));
end;
end;
procedure TMainForm.ProcessArgument(const Arg: string);
begin
ListBox1.Items.Add(Arg);
end;
procedure TMainForm.WMCopyData(var Message: TWMCopyData);
var
Arg: string;
begin
SetString(Arg, PChar(Message.CopyDataStruct.lpData), (Message.CopyDataStruct.cbData div SizeOf(Char))-1);
ProcessArgument(Arg);
Application.Restore;
Application.BringToFront;
end;
end.
The logic goes something like this. When you start your application, you iterate through the list of running processes and see if your application is already running. If it is running, you need to activate the window of that instance and then exit.
Everything you need to do this is in the Windows API. I found this sample code on CodeProject.com that deals with processes:
http://www.codeproject.com/KB/system/Win32Process.aspx
On finding and activating a window, the basic approach is to find the window of interest using the window class name then activate it.
http://www.vb6.us/tutorials/activate-window-api
Hopefully this gives you a good starting point.
There are many answers here that show how to implement this. I want to show why NOT to use the FindWindow approach.
I am using FindWindow (something similar with the one shown by David H) and I have seen it failed starting with Win10 - I don't know what they changed in Win10.
I think the gap between the time when the app starts and the time when we set the unique ID via CreateParams is too big so another instance has somehow time to run in this gap/interval.
Imagine two instances started at only 1ms distance (let's say that the user click the EXE file and then presses enter and keeps it pressed by accident for a short while). Both instances will check to see if a window with that unique ID exists, but none of them had the chance to set the flag/unique ID because creating the form is slow and the unique ID is set only when the form is constructed. So, both instances will run.
So, I would recommend the CreateSemaphore solution instead:
https://stackoverflow.com/a/460480/46207
Marjan V already proposed this solution but didn't explained why it is better/safer.
I'd use mutexes. You create one when your program starts.
When the creation fails it means another instance is already running. You then send this instance a message with your command line parameters and close. When your app receives a message with a command line, it can parse the parameters like you are already doing, check to see whether it already has the file(s) open and proceed accordingly.
Processing this app specific message ia also the place to get your app to the front if it isn't already. Please do this politely (SetForegroundWindow) without trying to force your app in front of all others.
function CreateMutexes(const MutexName: String): boolean;
// Creates the two mutexes to see if the program is already running.
// One of the mutexes is created in the global name space (which makes it
// possible to access the mutex across user sessions in Windows XP); the other
// is created in the session name space (because versions of Windows NT prior
// to 4.0 TSE don't have a global name space and don't support the 'Global\'
// prefix).
var
SecurityDesc: TSecurityDescriptor;
SecurityAttr: TSecurityAttributes;
begin
// By default on Windows NT, created mutexes are accessible only by the user
// running the process. We need our mutexes to be accessible to all users, so
// that the mutex detection can work across user sessions in Windows XP. To
// do this we use a security descriptor with a null DACL.
InitializeSecurityDescriptor(#SecurityDesc, SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(#SecurityDesc, True, nil, False);
SecurityAttr.nLength := SizeOf(SecurityAttr);
SecurityAttr.lpSecurityDescriptor := #SecurityDesc;
SecurityAttr.bInheritHandle := False;
if (CreateMutex(#SecurityAttr, False, PChar(MutexName)) <> 0 )
and (CreateMutex(#SecurityAttr, False, PChar('Global\' + MutexName)) <> 0 ) then
Result := True
else
Result := False;
end;
initialization
if not CreateMutexes('MyAppNameIsRunningMutex') then
//Find and SendMessage to running instance
;
end.
Note: above code is adapted from an example on the InnoSetup site. InnoSetup creates installer applications and uses this approach in the installer to check whether (a previous version of) the application being installed is already running.
Finding the other instance and sending it a message, I'll leave for another question (or you can use the WM_COPYDATA approach from David's answer). Actually, there is a StackOverflow question that deals exactly with this: How to get the process thread that owns a mutex Getting the process/thread that owns the mutex may be a bit of a challenge, but the answers to this question do address ways to get the information from one instance to the other.
Windows has different ways to handle file associations to executable.
The "command line" approach is only the simplest one, but also the most limited one.
It also supports DDE (it still works although officially deprecated) and COM (see http://msdn.microsoft.com/en-us/library/windows/desktop/cc144171(v=vs.85).aspx).
If I recall correctly both DDE and COM will let your application receive the whole list of selected files.
I used window/message approach by myself with addition of events for tracking if the other instance is running:
Try to create event "Global\MyAppCode" (the "Global" namespace is used for handling various user sessions as I needed single instance system-wide; in your case you'll probably prefer "Local" namespace which is set by default)
If CreateEvent returned error and GetLastError = ERROR_ALREADY_EXISTS then the instance is running already.
FindWindow/WM_COPYDATA to transfer data to that instance.
But the drawbacks with messages/windows are more than significant:
You must always keep your window's Caption constant. Otherwise you'll have to list all the windows in the system and loop through them for partial occurrence of some constant part. Moreover the window's caption could be easily changed by a user or 3rd part app so the search would fail.
Method requires a window to be created so no console/service apps, or they must create a window and perform message loop especially for handling the single instance.
I'm not sure FindWindow could find a window that is opened in another user session
For me, WM_COPYDATA is rather awkward method.
So currently I'm a fan of named pipe approach (haven't implemented it yet though).
On launch, app tries to connect to "Global\MyAppPipe". If successed, other instance is running. If failed, it creates this pipe and finishes instance check.
2nd instance writes the required data to pipe and exits.
1st instance receives data and does some stuff.
It works through all user sessions (with namespace "Global") or just a current session; it doesn't depend on strings used by UI (no localization and modification issues); it works with console and service apps (you'll need to implement pipe reading in a separate thread/message loop though).

Help needed coding an IRC client in Delphi 2010 using Indy Components

Im trying to code a basic irc client in Delphi 2010 using Indy components.
Im able to connect to my irc server (unrealircd) using sample A below.
After connecting I have many procedures that should perform actions when it receives a private message, ping, ctcp, channel modes etc. but they never react to any of these incoming events.
Sample A:
This connects to the IRC server when button4 is pressed.
It sucessfully joins the channel with the name specified.
procedure TForm1.Button4Click(Sender: TObject);
begin
IdIRC1.Host := '72.20.53.142';
IdIRC1.Port := 6667;
IdIRC1.Nickname := ssh.frmmain.Edit1.text;//insert your nickname here
try
idIRC1.Connect;
except
if not idIRC1.Connected then
begin
Memo2.Lines.add('Error Connecting to ' + idIRC1.Host);
Exit;
end;
end;
Memo2.Lines.add ('Connected to Auth Server');
idIRC1.Join(channel,key);
Memo2.Lines.add ('Auth Accepted');
end;
These events dont work at all and no errors are generated during a compile.
procedure TForm1.IdIRC1Connected(Sender: TObject);
begin
memo2.Lines.Clear;
memo2.Lines.add ('2Connected');
end;
procedure TForm1.IdIRC1ServerVersion(ASender: TIdContext; Version, Host, Comments: String);
begin
memo2.Lines.Add(Version +'Host '+Host+'Comments '+Comments);
end;
Ive had a few people look at this, and it just seems theres some unicode issues that destroyed my TClientSocket irc setup, and even when I moved to indy and used samples off the official site I was still unable to get anything to fire such as the onconnect event.
A friend had a copy of an application he wrote in Delphi 2010 using the same version of indy and I managed to import his project and it started working.
Not sure why

Resources