I have the following situation:
function Mach3Code(Str: String): String;
var StrOut: String;
begin
StrOut := '';
try
IdTelnet1.Connect();
IdTelnet1.Write(Str);
StrOut := ''; // assign here return output;
finally
IdTelnet1.Disconnect;
end;
Result := StrOut;
end;
On the line "StrOut := '';" I need to get the text output of the server (which is a tcp server, written in vc 2008 by me as Mach3 plugin).
Normally, the client sends "COMMAND1" and the server replies with "ANSWER1#" or something like this. I need the code to wait for the answer and then return it, synchronously, so I can do something like:
StrResult := Mach3Code('G0X300Y200');
and read what the server part has sent to me.
any ideas how I can solve this problem?
TIdTelnet is an asynchronous componnt, it is not suited for what you are attempting to do. Unless you are dealing with the actual Telnet protocol, then you should use TIdTCPClient instead:
function Mach3Code(const Str: String): String;
begin
Result := '';
try
IdTCPClient1.Connect();
IdTCPClient1.WriteLn(Str);
StrOut := IdTCPClient1.ReadLn('#');
finally
IdTCPClient1.Disconnect;
end;
end;
to receive data assign an event handler of type TIdTelnetDataAvailEvent to the OnDataAvailable property of idtelnet1, i know this is not synchronous but i would re factor your code to work this way as this is how the telnet client is designed to work.
Failing that create your own TIdTCPClientCustom decendant and implement your own read thread with the relevent methods.
Related
The code below works fine if executed as a single command. I use it to download PDFs that are typically a few megabytes in size.
However, when I execute it multiple times in a loop, all the downloaded files are exactly the same size (truncated # ~50KB). Is there an issue with my code or is this the server not being able to deliver as expected?
type
TKeyValuePair = record
Key: String;
Value: String;
end;
TKeyValueSet = Array of TKeyValuePair;
// ...
function TDM.MultipartPost(const URL, LocalFile: String; const MultipartData: TKeyValueSet): Boolean;
var
i: Integer;
httpclient: THTTPClient;
formdata: TMultipartFormData;
fstream: TFileStream;
begin
httpclient := THTTPClient.Create;
formdata := TMultipartFormData.Create();
fstream := nil;
try
fstream := TFileStream.Create(LocalFile, fmCreate);
except
// removed
end;
try
for i := Low(MultipartData) to High(MultipartData) do
formdata.AddField(MultipartData[i].Key, MultipartData[i].Value);
try
httpclient.Post(url, formdata, fstream);
except
// removed
end;
finally
FlushFileBuffers(fstream.Handle);
fstream.Free;
formdata.Free;
httpclient.Free;
//
Result := FileExists(LocalFile) and (GetFileSize(LocalFile) > 0);
end;
end;
Mea culpa - my apologies to all that read/replied to my post. I just built a minimal, but complete application to demonstrate the issue and, voila, it worked just fine.
1 hour or so of not seeing the forest for all the trees later:
I accidentally used an incorrect URL to post to :(
I am trying to write a proxy server in Indy to receive HTTPS calls from external clients and forward them in HTTP to another server application on the same machine. Reason is that the other application does not support SSL and so I want to wrap its traffic in an SSL layer for external security.
My current approach is to use a TIdHTTPserver with an SSL IOHandler, and in its OnCommandGet handler I create a TIdHTTP client on the fly which fetches a TFileStream ContentStream from the internal application and returns that stream as the Response.ContentStream to the external caller.
The problem with this approach is the latency caused by having to wait for the internal content stream to be fully received before the external stream can start to be sent. And for example it cannot work for streaming media.
My question is: is there a better way to proxy HTTPS to HTTP that would work for streams? I.e without having to use an intermediate file stream.
If the requesting client supports HTTP 1.1 chunking (see RFC 2616 Section 3.6.1), that would allow you to read data from the target server and send it immediately to the client in real-time.
If you are using a fairly recent version of Indy, TIdHTTP has an OnChunkReceived event, and an hoNoReadChunked flag in its HTTPOptions property:
New TIdHTTP flags and OnChunkReceived event
In your TIdHTTPServer.OnCommand... event handler, you can populate the AResponseInfo as needed. Make sure to:
leave AResponseInfo.ContentText and AResponseInfo.ContentStream unassigned
set AResponseInfo.ContentLength to 0
set AResponseInfo.TransferEncoding to 'chunked'
Then call the AResponseInfo.WriteHeader() method directly, such as in the TIdHTTP.OnHeadersRecceived event, to send the response headers to the client.
Then you can read the target server's response body using OnChunkedReceived or hoNoReadChunked, and write each received chunk to the client using AContext.Connection.IOHandler directly.
However, there are some caveats to this:
if you use the TIdHTTP.OnChunkReceived event, you still need to provide an output TStream to TIdHTTP or else the event is not triggered (this restriction might be removed in a future release). However, you can use TIdEventStream without assigning an OnWrite event handler to it. Or write a custom TStream class that overrides the virtual Write() method to do nothing. Or, just use any TStream you want, and have the OnChunkReceived event handler clear the received Chunk so nothing is available to write to the TStream.
if you use the hoNoReadChunked flag, this allows you to manually read the HTTP chunks from TIdHTTP.IOHandler directly after TIdHTTP exits. Just make sure you enable HTTP keep-alives or else TIdHTTP will close the connection to the server before you have a chance to read the server's response body.
If you are using an older version of Indy, or if the target server does not support chunking, all is not lost. You should be able to write a custom TStream class that overwrites the virtual Write() method to write the provided data block to the client as an HTTP chunk. And then you can use that class as the output TStream for TIdHTTP.
If the client does not support HTTP chunking, or if these approaches do not work for you, then you will likely have to resort to using TIdTCPServer directly instead of TIdHTTPServer and implement the entire HTTP protocol yourself from scratch, then you can handle your own streaming as needed. Have a look at the source code for TIdHTTPProxyServer for some ideas (TIdHTTPProxyServer itself is not suitable for your particular situation, but it will show you how to pass HTTP requests/responses between connections in near real-time in general).
Thank you for the very comprehensive answer. The way I finally solved it was to create a TStream descendent to use as the ContentStream for the server response. The TStream wis a wrapper around a TIdTcpClient which contains a rudimentary HTTP implementation and whose TStream.Read function fetches the HTTP contents for the Tcp connection.
type
TTcpSocketStream = class(TStream)
private
FAuthorization: string;
FBuffer: TBytes;
FBytesRead: Int64;
FCommand: string;
FContentLength: Int64;
FContentType: string;
FDocument: string;
FHeaders: TIdHeaderList;
FHost: string;
FIntercept: TServerLogEvent;
FPort: Integer;
FResponseCode: Integer;
FQueryParams: string;
FTcpClient: TIdTCPClient;
FWwwAuthenticate: string;
public
constructor Create;
destructor Destroy; override;
procedure Initialize;
function Read(var Buffer; Count: Longint): Longint; override;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
property Authorization: string read FAuthorization write FAuthorization;
property Command: string read FCommand write FCommand;
property ContentType: string read FContentType;
property ContentLength: Int64 read FContentLength;
property Document: string read FDocument write FDocument;
property Host: string read fHost write FHost;
property Intercept: TServerLogEvent read FIntercept write FIntercept;
property Port: Integer read FPort write FPort;
property QueryParams: string read FQueryParams write FQueryParams;
property ResponseCode: Integer read FResponseCode;
property WWWAuthenticate: string read FWwwAuthenticate
write FWwwAuthenticate;
end;
const
crlf = #13#10;
cContentSeparator = crlf+crlf;
implementation
{ TTcpSocketStream }
constructor TTcpSocketStream.Create;
begin
inherited;
FHeaders := TIdHeaderList.Create(QuoteHTTP);
FTcpClient := TIdTcpClient.Create(nil);
FTcpClient.ConnectTimeout := 5000;
FTcpClient.ReadTimeout := 5000;
FCommand := 'GET';
FPort := 443;
FResponseCode := 404;
end;
destructor TTcpSocketStream.Destroy;
begin
if FTcpClient.Connected then
FTcpClient.Disconnect;
if FTcpClient.Intercept <> nil then
begin
FTcpClient.Intercept.Free;
FTcpClient.Intercept := nil;
end;
FTcpClient.Free;
FHeaders.Free;
SetLength(FBuffer, 0);
inherited;
end;
procedure TTcpSocketStream.Initialize;
var
s: string;
LLog: TClientLogEvent;
LRespText: string;
begin
try
if FQueryParams <> '' then
FQueryParams := '?' + FQueryParams;
FTcpClient.Port := FPort;
FTcpClient.Host := FHost;
if FIntercept <> nil then
begin
LLog := TClientLogEvent.Create;
LLog.OnLog := FIntercept.OnLog;
FTcpClient.Intercept := LLog;
end;
FTcpClient.Connect;
if FTcpClient.Connected then
begin
FTcpClient.IOHandler.Writeln(Format('%s %s%s HTTP/1.1',
[FCommand, FDocument, FQueryParams]));
FTcpClient.IOHandler.Writeln('Accept: */*');
if FAuthorization <> '' then
FTcpClient.IOHandler.Writeln(Format('Authorization: %s',
[FAuthorization]));
FTcpClient.IOHandler.Writeln('Connection: Close');
FTcpClient.IOHandler.Writeln(Format('Host: %s:%d', [FHost, FPort]));
FTcpClient.IOHandler.Writeln('User-Agent: Whitebear SSL Proxy');
FTcpClient.IOHandler.Writeln('');
LRespText := FTcpClient.IOHandler.ReadLn;
s := LRespText;
Fetch(s);
s := Trim(s);
FResponseCode := StrToIntDef(Fetch(s, ' ', False), -1);
repeat
try
s := FTcpClient.IOHandler.ReadLn;
except
on Exception do
break;
end;
if s <> '' then
FHeaders.Add(s);
until s = '';
FContentLength := StrToInt64Def(FHeaders.Values['Content-Length'], -1);
FContentType := FHeaders.Values['Content-Type'];
FWwwAuthenticate := FHeaders.Values['WWW-Authenticate'];
end;
except
on E:Exception do ;
end;
end;
function TTcpSocketStream.Read(var Buffer; Count: Integer): Longint;
begin
Result := 0;
try
if FTcpClient.Connected then
begin
if Length(FBuffer) < Count then
SetLength(FBuffer, Count);
FTcpClient.IOHandler.ReadBytes(FBuffer, Count, False);
Move(FBuffer[0], PChar(Buffer), Count);
Inc(FBytesRead, Count);
Result := Count;
end;
except
on Exception do ;
end;
end;
function TTcpSocketStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
Result := 0;
case Origin of
soBeginning: Result := Offset;
soCurrent: Result := FBytesRead + Offset;
soEnd: Result := FContentLength + Offset;
end;
end;
what is the best method to do this: i have a txt file filled with web addresses, i have to check all of them using idHTTP component,only a simple check from a web server, downloading the html and finding a match, i want it to to be fast, there is different types of threads and i am not sure what is the best to use, a TParallel for or Task threads or regular threads?
i tried before TParallel for and i got stuck at AV, also i've tried Task threads but its not fast, the http request becomes slower by time, i tried also the regular threads and i didnt know how to use it because its complicated to use.
note: Please do NOT downvote i just need advice from the experts. Thank you
First advice: do not use Indy. Use THTTPClient (unit System.Net.HttpClient) -- native for Delphi XE?+
I am still using old TThreads. I could make suggestion only with TThread.
Workflow:
Main thread -- reading your TXT file line by line.
After line was readed, you create NEW thread, which are downloading information from WWW.
Sample of application:
unit ufmMain;
interface
uses
Winapi.Windows, Winapi.Messages,
System.SysUtils, System.Variants,
{ TThread }
System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TLoad = class(TThread)
protected
FURL,
FOutputFileName: String;
procedure Execute; override;
public
constructor Create(const AURL, AOutputFileName: String); overload;
end;
HTTP = class
public
class procedure Get(const AURL: String; out AOutputStream: TMemoryStream);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
{ THTTPClient }
System.Net.HttpClient;
procedure TForm1.Button1Click(Sender: TObject);
var
LLoad: TLoad;
LFile: TextFile;
LCycle: Integer;
LUrl: String;
begin
LCycle := 0;
AssignFile(LFile, 'urls.txt');
try
Reset(LFile);
while not Eof(LFile) do
begin
{ Using for generate file name. All file names must be unique }
Inc(LCycle);
{ Read next URL }
ReadLn(LFile, LUrl);
{ Create new thread }
LLoad := TLoad.Create(LUrl, 'Output file No ' + LCycle.ToString + '.htm');
LLoad.FreeOnTerminate := True;
LLoad.Start;
end;
finally
CloseFile(LFile);
end;
end;
{ TLoad }
constructor TLoad.Create(const AURL, AOutputFileName: String);
begin
inherited Create(True);
FURL := AURL;
FOutputFileName := AOutputFileName;
end;
procedure TLoad.Execute;
var
LResponse: TMemoryStream;
begin
inherited;
LResponse := TStringStream.Create;
try
HTTP.Get(FURL, LResponse);
{ Save result to file }
LResponse.SaveToFile(GetCurrentDir + PathDelim + FOutputFileName);
finally
LResponse.Free;
end;
end;
{ HTTP }
class procedure HTTP.Get(const AURL: String; out AOutputStream: TMemoryStream);
var
LStream: TStream;
LHTTPClient: THTTPClient;
begin
LHTTPClient := THTTPClient.Create;
try
LStream := LHTTPClient.Get(AURL).ContentStream;
AOutputStream.CopyFrom(LStream, LStream.Size);
finally
LHTTPClient.Free;
end;
end;
end.
Why I against Indy:
1) THTTPClient do not required additional DLL for works with SSL protocol
2) THTTPClient is modern from Delphi XE8
3) My subjective opinion: THTTPClient works much more smoothly (with less issues) then Indy library. I used Indy for last 10 years, but now all my supported project moved to THTTPClient.
You can use TTask and Indy (TIdHTTP). Example:
function GetUrl(const aUrl: string): ITask;
begin
Result := TTask.Run(
procedure
var
FOutput: string;
FHTTP: TIdHTTP;
begin
FHTTP:=TIdHTTP.Create(nil);
try
try
FOutput:=FHTTP.Get(aUrl);
except
// handle errors
end;
finally
FHTTP.Free;
end;
TThread.Synchronize(nil,
procedure
begin
ProcessOutput(FOutput); // send your output/result to main thread
end);
end );
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
list: TStringList;
begin
list:=TStringList.Create;
try
list.LoadFromFile('yourfile.txt');
// get all your urls
// you should control how many threads run at the same time
for i := 0 to list.Count-1 do
GetUrl(list[i]);
finally
list.Free;
end;
end;
Can anyone tell me what ControlGetHandle() does behind the scenes? What Windows API function does it invoke? How can I see it? (logs/debug mode).
It sometimes succeeds and sometimes fails and I don't understand why. I looked all over the place, including AutoIT .au3 include files, but I couldn't find any information.
So, I discovered this amazing tool called "API Monitor". It shows you API calls made to the OS. You can filter etc. When running AutoIT with "ControlGetHandle" you can see that it actually calls two functions:
EnumWindows
EnumChildWindows
With the relevant parameters to get the handle you wish.
Thanks!
I believe it uses GetDlgCtrlID among other things. If you are having trouble getting it to return a handle sometimes changing the controlID parameter will fix it. Also, make sure you are waiting for the control to load first. If the control exists and you are using the right controlID parameters AutoIt will be able to get a controls handle 99.9999% of the time.
The first thing that comes to mind, the function finds the window with matching caption, lists the controls, finds the control with suitable criteria( class name and text), and returns his HWnd. This is done using the API EnumWindows/GetWindowTextLength/GetWindowText,GetWindowClassName.
Here, I wrote a small example, but it is in Pascal ( Excuse me. later rewritten in AutoIt. ;) ;) ;)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
fhw:hwnd;
cls,txt:string;
wind:hwnd;
implementation
{$R *.dfm}
function GetText(wnd:hwnd):string;
var
len:integer;
begin
len:=GetWindowTextLength(wnd)+1;
SetLength(result,len);
SetLength(Result,GetWindowText(wnd,pchar(result),len));
end;
function GetClsName(wnd:hwnd):string;
begin
SetLength(result,5000);
SetLength(result,GetClassName(wnd,pchar(result),5000));
end;
function EnumChildProc(wnd:HWnd; param:Integer):bool;stdcall;
var
wintext,wincls:string;
ccmp,tcmp:boolean;
begin
wintext:=gettext(wnd);
wincls:=getclsname(wnd);
if cls <> '' then
ccmp:=(comparetext(cls,wincls)=0)
else
ccmp:=true;
if txt <> '' then
tcmp:=(comparetext(txt,wintext)=0)
else
tcmp:=true;
result:=not (tcmp and ccmp);
if not result then
wind:=wnd;
end;
procedure GetControlHandle(title:string; wtext:string; clsname:string);
var
hw:hwnd;
begin
wind:=0;
hw:=findwindow(nil,pchar(title));
if hw <> 0 then
begin
cls:=clsname;
txt:=wtext;
EnumChildWindows(hw,#EnumChildProc,integer(pointer(result)));
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
w:hwnd;
begin
getcontrolhandle('New Project','','Button');
w:=wind;
CloseWindow(w);
end;
end.
I am trying to create a simple object to handle all my database related functions. I have a functions to return a dataset or to execute a command. Now when i call this from my program I am able to fetch records using Execute_Dataset and it works fine but when i do an changes and execute a command by calling Execute_Command i get an error "database is locked" when the commit transaction is called. I have tried everything that i could be it still happens. Can someone put some light into what i am doing wrong and how i can prevent this from happening.
function TConnectionManager.Execute_Dataset(const ASql: string; const AParams:
array of variant; out VDataset: TDataset; const ATrn_Name: string): Boolean;
var
lTrn: TFDTransaction;
lQry: TFDQuery;
begin
Result := True;
lTrn:= TFDTransaction.Create (Self);
try
lTrn.Connection := FConnection;
lTrn.StartTransaction;
lQry := TFDQuery.Create (Self);
lQry.Connection := FConnection;
lQry.Transaction := lTrn;
try
if Length (AParams) > 0
then lQry.Open (ASql, AParams)
else lQry.Open (ASql);
VDataset := lQry;
Result := True;
{ Commit transaction if started within the procedure }
lTrn.Commit;
except
on e:Exception
do begin
{ Rollback transaction if started within the procedure }
lTrn.Rollback;
lQry.DisposeOf;
//log
raise;
end;
end;
finally
lTrn.DisposeOf;
end;
end;
procedure TConnectionManager.Execute_Command(const ASql: string; const AParams:
array of variant; const ATrn_Name: string);
var
lTrn: TFDTransaction;
lQry: TFDQuery;
begin
lTrn:= TFDTransaction.Create (Self);
try
lTrn.Connection := FConnection;
lTrn.StartTransaction;
lQry := TFDQuery.Create (Self);
lQry.Connection := FConnection;
lQry.Transaction := lTrn;
try
{ Execute command }
if Length (AParams) > 0
then lQry.ExecSQL (ASql, AParams)
else lQry.ExecSQL (ASql);
{ Commit transaction if started within the procedure }
lTrn.Commit;
except
on e:Exception
do begin
{ Rollback transaction if started within the procedure }
lTrn.Rollback;
//log
raise;
end;
end;
finally
lQry.DisposeOf;
lTrn.DisposeOf;
end;
end;
Thanks
Try setting the Connection's properties SharedCache to 'False' and LockingMode to 'Normal'.
The default value for the connection's locking mode is 'exclusive' which can cause this problem. You can do this by right clicking on your Connection-Component (on the form) and choosing ConnectionEditor (I'm not quite sure, if that's the right English word for it, but it should be called something like that) and then setting these values.
Alternatively you can set these properties in sourcecode:
connection.Params.Add('SharedCache=False');
connection.Params.Add('LockingMode=Normal');
I'm not sure that this is the best way to solve this problem. There might be a better solution to this.
Because other connection exist. Check connection component in datamodule
MyFDConnection.Connected:=False;
Sharedcache = false is indeed the best way to solve this problem. The components already support designtime connections.