I need to write a Delphi 2009 application, which reads data from a socket. To do this, I need to write an event handler for the TIdTCPServer.OnExecute event.
I found lots of examples for implementing this in GUI applications, but I need to do it in a console application (without any windows).
How should I modify the code below in order to add an event handler (attach it to TCPServer), which prints every received message into the debug output?
unit ReceivingThreadUnit;
interface
uses
Classes,
IdTCPServer,
IdSocketHandle,
SysUtils,
Windows;
type
ReceivingThread = class(TThread)
private
TCPServer: TIdTCPServer;
public
procedure Run();
end;
implementation
procedure ReceivingThread.Run();
var
Bindings: TIdSocketHandles;
begin
TCPServer := TIdTCPServer.Create(nil);
//setup and start TCPServer
Bindings := TIdSocketHandles.Create(TCPServer);
try
with Bindings.Add do
begin
IP := '127.0.0.1';
Port := 9998;
end;
try
TCPServer.Bindings:=Bindings;
// Here I want to attach TCPServer to an OnExecute event handler
TCPServer.Active:=True;
except on E:Exception do
OutputDebugString(PChar(E.ToString));
end;
finally
Bindings.Free;
TCPServer.Free;
end;
TCPServer.Active := true;
end;
end.
As David said (but did not fully show), you need to declare a method in your thread class and then assign it to the OnExecute event.
On a side note, you should not be creating a TIdSocketHandles collection manually. Call Add() on the existing TIdTCPServer.Bindings collection instead.
Try this:
unit ReceivingThreadUnit;
interface
uses
Classes,
IdTCPServer,
IdSocketHandle,
IdContext,
SysUtils,
Windows;
type
ReceivingThread = class(TThread)
private
TCPServer: TIdTCPServer;
procedure ExecuteHandler(AContext: TIdContext);
public
procedure Run;
end;
implementation
procedure ReceivingThread.ExecuteHandler(AContext: TIdContext);
begin
//...
end;
procedure ReceivingThread.Run;
begin
//setup and start TCPServer
TCPServer := TIdTCPServer.Create(nil);
try
with TCPServer.Bindings.Add do
begin
IP := '127.0.0.1';
Port := 9998;
end;
TCPServer.OnExecute := ExecuteHandler;
try
TCPServer.Active := True;
except
on E: Exception do
OutputDebugString(PChar(E.ToString));
end;
while not Terminated do
Sleep(1000);
TCPServer.Active := False;
finally
TCPServer.Free;
end;
end;
end.
With that said, your receiveing thread is actually pretty redundant since TIdTCPServer is already multi-threaded, so you could alternatively just eliminate the thread class altogether:
program MyApp;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Classes,
IdTCPServer,
IdSocketHandle,
IdContext,
SysUtils,
Windows;
type
TCPServerEvents = class
public
class procedure ExecuteHandler(AContext: TIdContext);
end;
class procedure TCPServerEvents.ExecuteHandler(AContext: TIdContext);
begin
//...
end;
var
TCPServer: TIdTCPServer;
begin
//setup and start TCPServer
TCPServer := TIdTCPServer.Create(nil);
try
with TCPServer.Bindings.Add do
begin
IP := '127.0.0.1';
Port := 9998;
end;
TCPServer.OnExecute := TCPServerEvents.ExecuteHandler;
try
TCPServer.Active := True;
except
on E: Exception do
OutputDebugString(PChar(E.ToString));
end;
while (not stop condition) do
Sleep(1000);
TCPServer.Active := False;
finally
TCPServer.Free;
end;
end.
You need to add an event handler to your class. And then connect it up:
TCPServer.OnExecute := Self.ExecuteHandler;
Related
I am successfully using Delphi's TRESTRequest.ExecuteAsync to query a REST API and parse the results without blocking the main thread.
This is for a mobile app with devices moving in and out of coverage, so I want to check that the server is reachable immediately prior to making the call. I tried using TRESTClient's timeout, but it takes 30 seconds to fire, even when Airplane mode is turned on.
I have a very quick and reliable function CheckServerIsAvailable, but it is synchronous. To avoid blocking the main thread, I call CheckServerIsAvailable via Task.Run, and using TThread.Synchronize to update my UI when it's done. This seems to work reliably.
However, I want the application to continue from that point and either show a message that the server is unavailable OR continue into making the call to the server. I don't want to put all the additional error checking and JSON parsing etc code inside the Thread.Synchronize procedure declaration as it will quickly become unreadable.
Thread.Synchronize docs says the anonymous procedure is called on the main thread, so I tried to continue the execution by calling another procedure from there as follows:
procedure TForm1.Button1Click(Sender: TObject);
begin
StartWithPart1;
end;
procedure TForm1.StartWithPart1;
begin
Label1.Text := 'Looking...';
AniIndicator1.Enabled := true;
TTask.Run(
procedure
begin
Connected := CheckServerIsReachable; // this is a blocking call
TThread.Synchronize(nil,
procedure
begin
Label1.Text := ifthen(Connected, 'Connected', 'Not connected');
AniIndicator1.Enabled := false;
ShowMessage('leaving part 1');
ContinueWithPart2;
end);
end);
end;
procedure TForm1.ContinueWithPart2;
begin
ShowMessage('entering part 2');
// this is where I want to make the REST call, handle errors and parse results etc
end;
This seems to work correctly, with the TAniIndicator animating and labels updating correctly, but when I run the code above, the message "entering part 2" appears before "leaving part 1", which makes me think that my (limited) understanding of TThread.Synchronize is either incorrect or incomplete or both.
Is this approach reasonable? Why does the second message appear before the first if TThread.Synchronize is executing on the main thread? Is there a better model to be using to achieve what I'm trying to do?
UPDATE:
Thanks for the awesome help, everyone - I wasn't aware that dialogs on mobile are async and order of presentation is independent of order of creation.
For completeness, I tried an alternative approach based on subclassing TThread which seems to work equally well, and I feel results in more readable code as follows:
unit ServerCheck;
interface
uses
System.SysUtils, System.Types, System.UITypes,
System.Classes, System.Variants, System.Threading,
IdTCPClient;
type
TServerCheck = class(TThread)
Connected: Boolean;
TCPClient: TIdTCPClient;
private
function IsServerReachable: Boolean;
public
constructor Create(host: string; port: Integer; timeout: Integer;
callback: TNotifyEvent);
destructor Destroy; override;
procedure Execute; override;
end;
implementation
const
BUSY = 1;
NOT_BUSY = 0;
constructor TServerCheck.Create(host: string; port: Integer; timeout: Integer;
callback: TNotifyEvent);
begin
inherited Create(true);
FreeOnTerminate := true;
OnTerminate := callback;
TCPClient := TIdTCPClient.Create;
TCPClient.host := host;
TCPClient.port := port;
TCPClient.ReadTimeout := timeout;
TCPClient.ConnectTimeout := timeout;
end;
destructor TServerCheck.Destroy;
begin
TCPClient.Free;
inherited;
end;
function TServerCheck.IsServerReachable: Boolean;
begin
try
if TCPClient.Tag = NOT_BUSY then
begin
TCPClient.Tag := BUSY;
TCPClient.Connect;
TCPClient.Disconnect;
TCPClient.Tag := NOT_BUSY;
result := true;
end
else
begin
result := false;
end
except
begin
TCPClient.Tag := NOT_BUSY;
result := false;
end;
end;
end;
procedure TServerCheck.Execute;
begin
Connected := IsServerReachable;
end;
end.
and then from another form:
procedure TForm1.Button1Click(Sender: TObject);
var
netCheck: TServerCheck;
begin
Label1.Text := 'Checking';
AniIndicator1.Visible := true;
AniIndicator1.Enabled := true;
netCheck := TServerCheck.Create('www.stackoverflow.com', 443, 6000, Callback);
netCheck.Start;
end;
procedure TForm1.Callback(Sender: TObject);
begin
AniIndicator1.Enabled := false;
AniIndicator1.Visible := false;
Label1.Text := IfThen(TServerCheck(Sender).Connected, 'Connected', 'Not connected');
end;
I have a Lazarus console app where I have a simple TIdTCPServer. To be a thread safe app, I added TLog.LogMsg() (which uses TIdNotify).
The problem is, when I call this function from the main thread, the message appears on the console, but when it is called from the OnExecute or OnConnect event of TIdTCPServer, the message is not displayed.
Can you help me with this problem?
program Srv;
{$I Synopse.inc}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, Generics.Collections, IdTCPServer, IdCustomTCPServer, IdContext, IdGlobal, Db, mORMot, mORMotSQLite3, IdSync, functions, SynCommons, SynSQLite3Static;
type
{ TMyApplication }
TMyApplication = class(TCustomApplication)
var IdTCPServer: TIdTCPServer;
protected
procedure DoRun; override;
procedure ServerOnConnect(AContext: TIdContext);
procedure ServerOnExecute(AContext: TIdContext);
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
type
TLog = class(TIdNotify)
protected
FMsg: string;
procedure DoNotify; override;
public
class procedure LogMsg(const AMsg: string);
end;
{ TMyApplication }
procedure TLog.DoNotify;
var i:integer;
begin
writeln(FMsg);
end;
class procedure TLog.LogMsg(const AMsg: string);
begin
with TLog.Create do
try
FMsg := AMsg;
Notify;
except
Free;
raise;
end;
end;
procedure TMyApplication.ServerOnExecute(AContext: TIdContext);
begin
TLog.LogMsg('test OnExecute'); // the message is not displayed
end;
procedure TMyApplication.ServerOnConnect(AContext: TIdContext);
begin
TLog.LogMsg('connect'); // the message is not displayed
end;
procedure TMyApplication.DoRun;
begin
TLog.LogMsg('test main 1'); //the message is displayed
IdTCPServer := TIdTCPServer.Create;
try
//Server.Name := 'Server';
IdTCPServer.ListenQueue := 15;
IdTCPServer.MaxConnections := 0;
IdTCPServer.TerminateWaitTime := 5000;
IdTCPServer.Bindings.Add.IP := '0.0.0.0';
IdTCPServer.Bindings.Add.Port := 80;
IdTCPServer.Bindings.Add.IPVersion:=Id_IPv4;
IdTCPServer.OnConnect := ServerOnConnect;
// IdTCPServer.OnDisconnect := ServerOnDiconnect;
//Server.OnException := IdTCPServer1Exception;
IdTCPServer.OnExecute := ServerOnExecute;
IdTCPServer.Active := True;
TLog.LogMsg('test main 2'); //the message is displayed
finally
// IdTCPServerCmd.Free;
end;
readln;
// stop program loop
Terminate;
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException := True;
end;
destructor TMyApplication.Destroy;
begin
IdTCPServer.Free;
inherited Destroy;
end;
var
Application: TMyApplication;
begin
Application := TMyApplication.Create(nil);
Application.Title := 'My Application';
Application.Run;
Application.Free;
end.
Your main thread does not have a message loop to process TThread.Synchronize()/TThread.Queue() requests. It is blocked on Readln(). Since you are in a console app and not a GUI app, you need to manually call Classes.CheckSynchronize() periodically in the main thread.
On a side note, you are calling IdTCPServer.Bindings.Add() too many times. In your example, you need to call it only 1 time, creating 1 binding that has the 3 property values assigned to it. But instead, you are calling it 3 times, creating 3 separate bindings with 3 separate property settings. It should look more like this instead:
with IdTCPServer.Bindings.Add do
begin
IP := '0.0.0.0';
Port := 80;
IPVersion := Id_IPv4;
end;
Which can be simplified as 0.0.0.0 and Id_IPv4 are already the default values, so they can be omitted from your code. And TIdTCPServer has a DefaultPort property you can use instead. The TIdTCPServer.Active property setter will create its own default bindings if there are none defined explicitly.
I want to make a function on the Idtcpclient that repeats the ReadLn command.
But how can i do this? I don't want to use a timer because a timer is slow.
I allready searched on google but i don't understand it..
The client can be placed in a separate thread, and use a loop to repeat the ReadLn until it succeeds. The time out can be given as an argument to ReadLn so that the next try will happen after the timeout interval. Make sure to handle connection loss, for example by reconnecting in a loop.
I create a unit to my program, I hope to help you:
unit uSerialAuthentication;
interface
uses System.SysUtils, IdTCPClient, IdThreadComponent, FMX.Dialogs;
type
TSerialAuthentication = class (TObject)
IdTCPClient: TIdTCPClient;
procedure IdThreadComponentRun(Sender: TIdThreadComponent);
public
constructor Create (Host : string; Port: Word);
destructor Destroy; override;
procedure OnConnect(Sender: TObject);
end;
var
idThreadComponent : TIdThreadComponent; // Thread
Access : Boolean;
implementation
{ SerialAuthentication }
procedure TSerialAuthentication.OnConnect(Sender: TObject);
begin
ShowMessage('Connected');
IdThreadComponent.Active := True;
end;
constructor TSerialAuthentication.Create(Host : string; Port: Word);
begin
IdTCPClient := TIdTCPClient.Create();
IdTCPClient.Host := Host;
IdTCPClient.Port := Port;
IdTCPClient.OnConnected := OnConnect;
idThreadComponent := TIdThreadComponent.Create();
idThreadComponent.OnRun := IdThreadComponentRun;
Access := False;
end;
destructor TSerialAuthentication.Destroy;
begin
IdTCPClient.Disconnect;
if idThreadComponent.active then
begin
idThreadComponent.active := False;
end;
FreeAndNil(IdThreadComponent);
if Assigned(IdTCPClient) then
FreeAndNil (IdTCPClient);
inherited;
end;
procedure TSerialAuthentication.IdThreadComponentRun(Sender: TIdThreadComponent);
var
recv : String;
begin
recv := IdTCPClient.IOHandler.ReadLn(); // READ
if length(recv)>0 then
if recv = 'Ready' then
Access := True
else
Access := False;
end;
end.
I want to send email in other unit with different thread with indy10.0.52
I have source code
unit ThreadEmail;
interface
uses Classes, SysUtils, IdGlobal, IdMessage, IdIOHandler, IdIOHandlerSocket,
IdSSLOpenSSL, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdSMTP, IdExplicitTLSClientServerBase, IdSMTPBase,
IdIOHandlerStack, IdSSL, ExtCtrls;
type
TThreadEmail = class(TThread)
private
run : boolean;
counter : Integer;
target : Integer;
IdSMTP: TIdSMTP;
IdSSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
Messages : Array [0..10] of TIdMessage;
procedure checkRun();
protected
procedure Execute; override;
public
constructor Create(timerInS:Integer;host:string;port:integer;username,password:String;readTimeout : integer = 0);reintroduce;
function expressSend(recipients,subject,body:string;from:String='';replayTo:String='') :boolean;
function makeEmail(recipients,subject,body:string;from:String='';replayTo:String=''): boolean;
procedure SendAllEmail();
end;
implementation
constructor TThreadEmail.Create(timerInS:Integer;host:string;port:integer;username,password:String;readTimeout : integer = 0);
var b: byte;
begin
inherited Create(False);
Priority:= tpNormal;
FreeOnTerminate:= True;
IdSMTP := TIdSMTP.Create;
IdSSLIOHandlerSocketOpenSSL := TIdSSLIOHandlerSocketOpenSSL.Create();
for b:=low(Messages) to high(messages) do Messages[b] := nil;
IdSMTP.IOHandler := IdSSLIOHandlerSocketOpenSSL;
IdSMTP.UseTLS := utUseImplicitTLS;
IdSMTP.Host := host;
IdSMTP.Port := port;
IdSMTP.Username := username;
IdSMTP.Password := password;
IdSSLIOHandlerSocketOpenSSL.DefaultPort := 0;
IdSSLIOHandlerSocketOpenSSL.Destination := host+':'+inttostr(port);
IdSSLIOHandlerSocketOpenSSL.Host := host;
IdSSLIOHandlerSocketOpenSSL.MaxLineAction := maException;
IdSSLIOHandlerSocketOpenSSL.Port := port;
IdSSLIOHandlerSocketOpenSSL.ReadTimeout := readTimeout;
IdSSLIOHandlerSocketOpenSSL.SSLOptions.Method := sslvSSLv3;
IdSSLIOHandlerSocketOpenSSL.SSLOptions.Mode := sslmClient;
run:=true;
//target := timerInS*10;
end;
function TThreadEmail.expressSend(recipients,subject,body:string;from:String='';replayTo:String='') : boolean;
var IdMessage: TIdMessage;
begin
Result := false;
IdMessage := TIdMessage.Create();
IdMessage.Recipients.EMailAddresses := recipients;
IdMessage.Subject := subject;
IdMessage.Body.Text := body;
if from <> '' then IdMessage.From.Address := from;
if replayTo <> '' then IdMessage.ReplyTo.EMailAddresses := from;
try
IdSMTP.Connect();
IdSMTP.Send(IdMessage);
Result := true;
finally
IdSMTP.Disconnect();
end;
end;
function TThreadEmail.makeEmail(recipients,subject,body:string;from:String='';replayTo:String='') : boolean;
var b: byte;
begin
Result := false;
for b:=low(Messages) to high(messages) do
if Messages[b] = nil then
begin
Result := true;
Messages[b]:= TIdMessage.Create();
Messages[b].Recipients.EMailAddresses := recipients;
Messages[b].Subject := subject;
Messages[b].Body.Text := body;
if from <> '' then Messages[b].From.Address := from;
if replayTo <> '' then Messages[b].ReplyTo.EMailAddresses := from;
end;
if not(result) then
begin
SendAllEmail();
makeEmail(recipients,subject,body,from,replayTo);
end;
end;
procedure TThreadEmail.SendAllEmail();
var b: byte;
begin
try
IdSMTP.Connect();
for b:=low(Messages) to high(messages) do
if run and (Messages[b] <> nil) then
begin
try
IdSMTP.Send(Messages[b]);
finally
Messages[b].Free;
Messages[b] := nil;
end
end;
finally
IdSMTP.Disconnect();
end;
end;
procedure TThreadEmail.checkRun();
begin
Dec(counter);
if counter <= 0 then SendAllEmail();
end;
procedure TThreadEmail.Execute;
var b: byte;
begin
while run do
begin
sleep(100);
checkRun();
end;
IdSMTP.Free;
IdSSLIOHandlerSocketOpenSSL.Free;
for b:=low(Messages) to high(messages) do
if Messages[b] <> nil then Messages[b].Free;
end;
end.
and in mainfrom that i create
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ThreadEmail;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var ThreadEmail : TThreadEmail;
begin
ThreadEmail := ThreadEmail.Create(10,'smtp.gmail.com',465,'xxx.gmail.com','xxx',2000);
ThreadEmail.expressSend('xxx#yahoo.com','TES','TES');
end;
When button1 clicked, it always "create access violation error", Why it happend? can anyone help me? as a info, i sucesed send a email before, but i want to make a singgle unit that can run alone.
thanks
ThreadEmail := ThreadEmail.Create(10,'s....
this should be :
ThreadEmail := TThreadEmail.Create(10,'s....
Not sure if that's just a typo? It will definitely cause an AV if not.
In any case, ThreadEmail.expressSend will not run in your TThread's thread the way you are calling it. When you run a TThread the code in its Execute method will run in a separate thread. Any of the public member methods, however, can be called on an instance just like public methods of any class and they are executed on the thread that calls them.
To get this to work you need to have the Execute method performing the calls to send the email message. The UI thread needs to trigger action in the Execute method and not perform the action itself; this can be done by any number of means (having Execute synchronize with WaitForSingleObject, via message passing, etc).
The rest of your code looks rather broken. Your Execute code is not really going to work as it is - this loop :
while run do
begin
sleep(100);
checkRun();
end;
will never terminate as it seems you don't set run to false anywhere. Furthermore, counter does not seem to get set anywhere (nor do I really understand its purpose) so this will just SendAllEmail() every 100ms or so.
The makeEmail function will never terminate (stack overflow) since it calls itself recursively with the original arguments and the logic guarantees re-entry on each pass. It also looks like it will send whatever message eleven times on each recursion (since all 11 elements of Messages will be nil after initialization and after each call to SendAllEmail().
Even if you fix this - if you are calling makeEmail externally (ie: from the UI or another thread) then this will likely end up with all sorts of cross-thread errors since both Execute and the calling thread will be trying to call SendAllEmail at the same time. This code will need some work.
I have a project which does financial reports and I want to let user to be able to get this reports through the internet
I tried using TIdHTTPServer which is an Indy component to make my application to work as an HTTP Server and to let it to be able
receive request -> process the request -> send back the result of the request process
using a special port.
now my problem is that I'm getting a lot of Access Violation errors and random exceptions
it looks like about threads problem or I don't know because if I process the same request without using the TIdHTTPServer I don't get any problem
i'm using the OnCommandGet Event to process the request and send the result back to user inside the context stream.
what I need is a demonstration on how to use it with TADODataSet and TADOConnection
for example I need the user to be able to send a request and the TIdHTTPServer takes the request (for example call a stored procedure using to ADODataSet and take the result as XML file and send it back to the user)
please help....thank you.
one possibility how a Server could work ...
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,IDContext, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, StdCtrls, DB, ADODB;
type
TForm3 = class(TForm)
IdTCPServer1: TIdTCPServer;
Memo1: TMemo;
Button1: TButton;
DummyConnection: TADOConnection;
procedure Button1Click(Sender: TObject);
procedure IdTCPServer1Execute(AContext: TIdContext);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form3: TForm3;
implementation
uses ComObj,AdoInt,ActiveX;
{$R *.dfm}
function SendStream(AContext: TIdContext; AStream: TStream): Boolean;
begin
Result := False;
try
AContext.Connection.IOHandler.Write(AStream.Size); // sending length of Stream first
AContext.Connection.IOHandler.WriteBufferOpen;
AContext.Connection.IOHandler.Write(AStream, AStream.Size);
AContext.Connection.IOHandler.WriteBufferFlush;
finally
AContext.Connection.IOHandler.WriteBufferClose;
end;
Result := True;
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
IdTCPServer1.Active := true;
end;
{ Clientside function
Function RecordsetFromXMLStream(Stream:TStream): _Recordset;
var
RS: Variant;
begin
RS := CreateOleObject('ADODB.Recordset');
RS.Open(TStreamAdapter.Create(Stream) as IUnknown);
Result := IUnknown(RS) as _Recordset;
end;
}
Procedure RecordsetToXMLStream(const Recordset: _Recordset;Stream:TStream);
var
RS: Variant;
begin
if Recordset = nil then Exit;
RS := CreateOleObject('ADODB.Recordset');
RS := Recordset;
RS.Save(TStreamAdapter.Create(stream) as IUnknown, adPersistXML);
Stream.Position := 0;
end;
Procedure GetQueryStream(Const s,ConStr:String;ms:TMemoryStream);
var
AC:TAdoConnection;
ads:TAdodataset;
begin
AC:=TAdoConnection.Create(nil);
try
ads:=TAdodataset.Create(nil);
try
ads.Connection := AC;
AC.ConnectionString := ConStr;
ads.CommandText := s;
ads.Open;
RecordsetToXMLStream(ads.Recordset,ms);
finally
ads.Free
end;
finally
AC.Free
end;
end;
procedure TForm3.IdTCPServer1Execute(AContext: TIdContext);
var
cmd:String;
ms:TMemoryStream;
begin
CoInitialize(nil);
AContext.Connection.IOHandler.Readln(cmd);
ms:=TMemoryStream.Create;
try
GetQueryStream('Select * from Adressen',DummyConnection.ConnectionString,ms);
ms.Position := 0;
SendStream(AContext,ms);
AContext.Connection.Socket.CloseGracefully;
finally
ms.Free;
CoUninitialize;
end;
end;
end.