good evening!
I am trying to make a connection with Tethering, following the explanations of Malcon Groves (http://www.malcolmgroves.com/blog/?p=1854), however I am having the following problem:
When you click Connect, App1 apparently connects, but does not display the App2 handle.
App2 happens the same thing .... ....
I inserted the tetheringappprofile and tetheringmanager components and made the settings indicated ....
The codes are:
//App1
procedure TForm1.ConnectClick(Sender: TObject);
begin
TetheringManager1.AutoConnect;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := Format('App1 : %s',[tetheringmanager1.Identifier]);
end;
procedure TForm1.TetheringManager1PairedToRemote(const Sender: TObject;
const AManagerInfo: TTetheringManagerInfo);
begin
Label1.Text := Format('Connected : %s %s', [AManagerInfo.ManagerIdentifier,
AManagerInfo.ManagerName]);
end;
procedure TForm1.TetheringManager1RequestManagerPassword(const Sender: TObject;
const ARemoteIdentifier: string; var Password: string);
begin
Password := '1234';
end;
.
//App2
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := Format('App2 : %s', [tetheringmanager1.Identifier]);
end;
procedure TForm1.TetheringManager1PairedFromLocal(const Sender: TObject;
const AManagerInfo: TTetheringManagerInfo);
begin
Label1.Text := Format('Connected : %s %s',[AManagerInfo.ManagerIdentifier,
AManagerInfo.ManagerName]);
end;
Thanks!
When you use AutoConnect to discover other apps, the TetheringAppProfile.Group property in both apps has to be same.
Malcolm Groves has indeed great series of articles about App Tethering. I also attended presentation from Jens Fudge about the subject. Otherwise very hard to master. Thank you guys!
Delphi ships itself with number of useful samples about App Tethering. They are located in directory: ..\Samples\Object Pascal\RTL\Tethering\
#Dave: connection through IPv6 should be possible. Did you try AllowedAdapters property?
http://docwiki.embarcadero.com/Libraries/Tokyo/en/System.Tether.Manager.TTetheringManager.AllowedAdapters
Related
I've 2 Apps Let's call Server And Client.
I'm using Delphi-xe8. App ->Multi-Device Application
In Both Side using: App tethering[tManager,tAProfile], SQLite Database.
In Server SQLite Database I've 6 images. I would like to View that images In Client Side.
In Client Side I've 6 [TImage].
When I Click Button 'Get Image List' I'm getting 6 images with the same view.
I would like 6 images view differently.->[Get From Server Database]
Client "Get Image List" button Code:
procedure TForm1.GetImgLstClick(Sender: TObject);
begin
tAProfile.SendString(tManager.RemoteProfiles.First,'GetImages','');
end;
Server Received Code:
procedure TForm2.tAProfileResourceReceived(const Sender: TObject;
const AResource: TRemoteResource);
var
MS1:TMemorystream;
begin
if AResource.Hint='GetImages' then
begin
MS1:=TMemorystream.Create;
rQuery.Close;
rQuery.SQL.Clear;
rQuery.SQL.Add('select image from users');
rQuery.Open;
while not rQuery.Eof do
begin
tblobField(rQuery.FieldByName('image')).SaveToStream(MS1);
Image1.Bitmap:=nil;
rQuery.Next;
end;
tAProfile.SendStream(tManager.RemoteProfiles.First,'SendImages',MS1);
end;
end;
Client Received Code:
procedure TForm1.tAProfileResourceReceived(const Sender: TObject;
const AResource: TRemoteResource);
var
MS:TMemoryStream;
begin
if AResource.Hint='SendImages' then
begin
Image1.Bitmap.LoadFromStream(AResource.Value.AsStream);
Image2.Bitmap.LoadFromStream(AResource.Value.AsStream);
Image3.Bitmap.LoadFromStream(AResource.Value.AsStream);
Image4.Bitmap.LoadFromStream(AResource.Value.AsStream);
Image5.Bitmap.LoadFromStream(AResource.Value.AsStream);
Image6.Bitmap.LoadFromStream(AResource.Value.AsStream);
end;
end;
Update: I gather from your most recent comment that you want to send your
images one-by-one.
A problem is that a Delphi dataset's TGraphicField supports a number of formats
which may be of variable size, so if you just write them to the server's outbound
stream, there is no way for the client to know, when reading the stream, where the
data of one image ends and the next one begins. A simple solution to that is to have
the server write the size of the image to the stream before it writes the image's
data to the stream, and get the client's code to read the image size so that it
knows how much of what follows is the image's data.
I'm going back to the answer I posted to your other q (Delphi: How to Get All Images From Server Database by using App tethering?), which uses TClientDataSets,
but adapting it so that it sends only the images (and their sizes) in the stream. The
code is still quite simple and should be no different in principle than using FireDAC datasets and a Sqlite data table:
Server
procedure TApp1Form.SendImageStream;
var
StreamToSend,
ImageStream : TMemoryStream;
StreamedImageSize : Integer;
begin
StreamToSend := TMemoryStream.Create;
ImageStream := TMemoryStream.Create;
try
CDS1.DisableControls;
CDS1.First;
while not CDS1.Eof do begin
ImageStream.Clear;
CDS1Graphic.SaveToStream(ImageStream);
ImageStream.Position := 0;
StreamedImageSize := ImageStream.Size;
StreamToSend.Write(StreamedImageSize, SizeOf(Integer));
StreamToSend.CopyFrom(ImageStream, StreamedImageSize);
CDS1.Next;
end;
StreamToSend.Position := 0;
TetheringAppProfile1.Resources.FindByName('BioLife').Value := StreamToSend;
finally
CDS1.EnableControls;
ImageStream.Free;
end;
end;
Client
// Note: In the client, CDS1 has only two fields, one named ID which is an
// ftAutoInc field, and Graphic, which is a TGraphicField
procedure TApp2Form.TetheringAppProfile1Resources0ResourceReceived(const Sender:
TObject; const AResource: TRemoteResource);
var
ReceivedStream : TStream;
ImageStream : TMemoryStream;
ImageSize : Integer;
begin
AResource.Value.AsStream.Position := 0;
ReceivedStream := AResource.Value.AsStream;
ImageStream := TMemoryStream.Create;
try
if CDS1.Active then
CDS1.EmptyDataSet // discard existing data
else
CDS1.CreateDataSet;
CDS1.DisableControls;
while ReceivedStream.Position < ReceivedStream.Size - 1 do begin
ImageStream.Clear;
ReceivedStream.ReadBuffer(ImageSize, SizeOf(Integer));
ImageStream.CopyFrom(ReceivedStream, ImageSize);
CDS1.Insert;
TGraphicField(CDS1.FieldByName('Graphic')).LoadFromStream(ImageStream);
CDS1.Post;
end;
CDS1.First;
finally
ImageStream.Free;
CDS1.EnableControls;
end;
end;
Original answer follows
I have already shown you a very simple way to move images between server and client app using TClientDataSets in my answer to your q Delphi: How to Get All Images From Server Database by using App tethering?. I assumed you knew enough about Delphi programming to be able to get the data from your Sqlite db into a TCientDataSet but perhaps not.
Below is the code for the server + client of my other answer, adapted to use FireDAC components instead of TClientDataSets. Again, it uses the server dataset's SaveToStream method to save its data to the stream from the server and LoadFromStream on the client side.
Notice that there are only two lines of code in the client app.
FDApp1 code:
type
TApp1Form = class(TForm)
TetheringManager1: TTetheringManager;
TetheringAppProfile1: TTetheringAppProfile;
DBImage1: TDBImage;
btnConnect: TButton;
Label1: TLabel;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
btnSendStream: TButton;
FDConnection1: TFDConnection;
FDQuery1: TFDQuery;
FDGUIxWaitCursor1: TFDGUIxWaitCursor;
FDStanStorageBinLink1: TFDStanStorageBinLink;
procedure btnConnectClick(Sender: TObject);
procedure btnSendStreamClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TetheringManager1PairedToRemote(const Sender: TObject; const
AManagerInfo: TTetheringManagerInfo);
private
procedure DataSetToStream;
end;
[...]
procedure TApp1Form.btnConnectClick(Sender: TObject);
begin
TetheringManager1.AutoConnect;
end;
procedure TApp1Form.btnSendStreamClick(Sender: TObject);
begin
DataSetToStream;
end;
procedure TApp1Form.FormCreate(Sender: TObject);
begin
Caption := Format('App1 : %s', [TetheringManager1.Identifier]);
FDQuery1.LoadFromFile('D:\D10\Samples\Data\BioLife.FDS');
end;
procedure TApp1Form.TetheringManager1PairedToRemote(const Sender: TObject; const
AManagerInfo: TTetheringManagerInfo);
begin
Label1.Caption := Format('Connected : %s %s',
[AManagerInfo.ManagerIdentifier,
AManagerInfo.ManagerName]);
end;
procedure TApp1Form.DataSetToStream;
var
Stream : TMemoryStream;
begin
Stream := TMemoryStream.Create;
FDQuery1.SaveToStream(Stream);
Stream.Position := 0;
TetheringAppProfile1.Resources.FindByName('BioLife').Value := Stream;
end;
FDApp2 code:
type
TApp2Form = class(TForm)
TetheringManager1: TTetheringManager;
TetheringAppProfile1: TTetheringAppProfile;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
DBImage1: TDBImage;
FDGUIxWaitCursor1: TFDGUIxWaitCursor;
FDMemTable1: TFDMemTable;
FDStanStorageBinLink1: TFDStanStorageBinLink;
procedure TetheringAppProfile1Resources0ResourceReceived(const Sender: TObject;
const AResource: TRemoteResource);
public
end;
[...]
procedure TApp2Form.TetheringAppProfile1Resources0ResourceReceived(const Sender:
TObject; const AResource: TRemoteResource);
begin
AResource.Value.AsStream.Position := 0;
FDMemTable1.LoadFromStream(AResource.Value.AsStream);
end;
Of course, on the client side, if for some reason you want the images (but not the other server data) copied into another dataset, you can do that by a row-by-row copy, similar to the code in your qs.
I am having problem with Firemonkey TEdit Uppercase in Android.
Code:
procedure TFormMain.Edit1KeyDown(Sender: TObject; var Key: Word;
var KeyChar: Char; Shift: TShiftState);
begin
KeyChar := UpCase(KeyChar);
end;
In Win32 it works but in Android it's not working.
You have to use ChangeTracking event. It works fine
This code works on Android
procedure TFormMain.Edit1Typing(Sender: TObject);
begin
Edit1.Text:=AnsiUpperCase(Edit1.Text);
Edit1.GoToTextEnd;
end;
This code works on windows:
procedure TFormMain.Edit1ChangeTracking(Sender: TObject);
var
thetext: String;
begin
thetext := Edit1.Text;
Edit1.OnChangeTracking := nil;
Edit1.Text := '';
Edit1.Text := AnsiUpperCase(thetext);
Edit1.OnChangeTracking := Edit1ChangeTracking;
Edit1.GoToTextEnd;
end;
Use ToUpper (Documentation) or AnsiUpperCase (Documentation) for strings.
UPDATE: Why are you using OnKeyDown? According to Documentation you must use OnChangeTracking: "This event provides the first opportunity to respond to modifications the user brought to the text of the edit control."
So put in OnChangeTracking something like
procedure TFormMain.Edit1ChangeTracking(Sender: TObject);
begin
Edit1.text:= AnsiUpperCase(Edit1.text);
end;
i've an FTP uploader project that uses a form created on run time to start uploading to multiple FTP Servers ( using Indy ) , my issue is as follows ( and i really need your help ) .
On a Form i put an IdFTP Component + an Upload button + public properties named FTPSrvAdrs and SrcFile + TrgFolder like this way :
type
TFtpUploader = class(TForm)
IdFTP: TIdFTP;
StartUpload:TButton;
UploadProgress:TProgressBar;
procedure StartUploadClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FFtpSrvAdrs:String;
FSrcFile:String;
FTargetFtpFld:String;
Procedure StartMyUpload();
procedure SetFtpAdrs(const value:string);
procedure SetSrcFile(const value:string);
procedure SetTargetFtpFld(const value:string);
{ Private declarations }
public
{ Public declarations }
property FtpAdrs:string read FFtpSrvAdrs write SetFtpAdrs;
property SourceFile:string read FSrcFile write SetSrcFile;
property TargetFtpFld:string read FTargetFtpFld write SetTargetFtpFld;
end;
var
FtpUploader: TFtpUploader;
implementation
procedure TFtpUploader.StartUploadClick(Sender: TObject);
begin
StartMyUpload();
end;
procedure TFtpUploader.SetFtpAdrs(const value: string);
begin
FFtpSrvAdrs:=value;
end;
procedure TFtpUploader.SetSrcFile(const value: string);
begin
FSrcFile:=value;
end;
procedure TFtpUploader.SetTargetFtpFld(const value: string);
begin
FTargetFtpFld:=value;
end;
procedure TFtpUploader.StartMyUpload;
var
FtpUpStream: TFileStream;
begin
ftpUpStream:= TFileStream.create(FSrcFile, fmopenread)
try
with IdFTP do begin
Host:= FFtpSrvAdrs;
Username:='MyUserName';
Password:='MyPassword';
end;
IdFTP.Connect(true, 1200)
IdFTP.Passive:= true;
IdFTP.ChangeDir(FTargetFtpFld)
IdFTP.Put(ftpUpStream,FSrcFile, false);
finally
ftpUpStream.Free;
end;
end;
procedure TFtpUploader.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
This Form will be created on RunTime ( 4 times = 4 buttons will launch it separately like this way :
in the main form i've this procedure :
Procedure MainForm.UploadTo(FTPSrv,SrcFile,FtpTargetFld:String);
var
FUploadFrm:TFtpUploader;
begin
FUploadFrm:=TFtpUploader.Create(nil);
if assigned(FUploadFrm) then
begin
FUploadFrm.FtpAdrs:=FTPSrv;
FUploadFrm.SourceFile:=SrcFile;
FUploadFrm.TargetFtpFld:=FtpTargetFld;
FUploadFrm.Show;
end;
end;
procedure MainForm.Button1Click(Sender: TObject);
begin
UploadTo('MyFtpSrv_1','MySrcFile_1','MyFtpTargetFld_1');
end;
procedure MainForm.Button2Click(Sender: TObject);
begin
UploadTo('MyFtpSrv_2','MySrcFile_2','MyFtpTargetFld_2');
end;
// same with other 2 buttons
the FtpUploader form is Created / Opened ( 4 instances ) ,The ISSUE IS when i click on StartUpload button the FTP upload process is not started on all these 4 instances , but i've to wait each upload process is done ( finished ) and the other will auto-start , that means not all upload processes are started in same time .
Thank you .
It seems you have to either change Indy library for some non-blocking in-background library (event based or completion port based), or to make your program multi-threading (with it's own bunch of problems like user clicking a button 20 times or closing the form while the process is going, or even closing the program on the run).
Based on http://otl.17slon.com/book/doku.php?id=book:highlevel:async it can look anything like this:
TFtpUploader = class(TForm)
private
CanCloseNow: boolean;
...
procedure TFtpUploader.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Self.CanCloseNow
then Action := caFree
else Action := caIgnore;
end;
procedure TFtpUploader.MyUploadComplete;
begin
Self.CanCloseNow := True;
Self.Close;
end;
procedure TFtpUploader.StartMyUpload;
begin
Self.CanCloseNow := false;
Self.Enabled := False;
Self.Visible := True;
Application.ProcessMessages;
Parallel.Async(
procedure
var
FtpUpStream: TFileStream;
begin
ftpUpStream:= TFileStream.create(FSrcFile, fmopenread)
try
with IdFTP do begin
Host:= FFtpSrvAdrs;
Username:='MyUserName';
Password:='MyPassword';
Connect(true, 1200)
Passive:= true;
ChangeDir(FTargetFtpFld)
// this does not return until uploaded
// thus would not give Delphi a chance to process buttons
// pressed on other forms.
Put(ftpUpStream,FSrcFile, false);
end;
finally
ftpUpStream.Free;
end;
end
,
Parallel.TaskConfig.OnTerminated(
procedure (const task: IOmniTaskControl)
begin
MyUploadComplete;
end;
);
end;
Or you can use simplier AsyncCalls library http://andy.jgknet.de/blog/bugfix-units/asynccalls-29-asynchronous-function-calls/
I have small problem (I wish it's small) with disconnecting server - I mean - only in the moment when I want to disconnect it from server application (server.active=false).
Here is my simple code:
type
PClient = ^TClient;
type
TClient = record
Name: string;
AContext: TIdContext;
end;
clients: TThreadList;
SERVER: TIdTCPServer;
procedure TX.SERVERConnect(AContext: TIdContext);
var
NewClient: PClient;
s:string;
begin
s := AContext.Connection.socket.ReadLn();
GetMem(NewClient, SizeOf(TClient));
NewClient.name:=s;
NewClient.AContext := AContext;
AContext.data := TObject(NewClient);
try
clients.LockList.Add(NewClient);
finally
clients.UnlockList;
end;
AContext.Connection.socket.writeln('E:');//answer to client - "all right"
End;
procedure TX.SERVERDisconnect(AContext: TIdContext);
var
AClient: PClient;
begin
AClient := PClient(AContext.data);
try
clients.LockList.Remove(AClient);
finally
clients.UnlockList;
end;
FreeMem(AClient);
AContext.data := nil;
end;
It have to works only for sending data to clients therefore I read only one data line in onconnect procedure - it contains login name.
Procedure for sending data in my code looks like (is it good?):
var
procedure TX.send(what: string; where: string);
i, ile: integer;
s: string;
Aclient: PClient;
list: tlist;
begin
list:= SERVER.Contexts.LockList;
try
for i := 0 to list.Count - 1 do
with TIdContext(list[i]) do
begin
AClient := PClient(data);
if where = ActClient^.name then
Connection.IOHandler.writeln(what);
end;
finally
SERVER.Contexts.UnlockList;
end;
end;
It looks it works good - I mean. But when I want to disable server by SERVER.active:=false application freezes? I tried to free clients etc. but it dosen't work in my bad code.
Could Somebody help me and give me advice how to stop server for this code?
Artik
I am trying to create an open dialog (in Windows 7) where the user is confined to the initial directory. On the open dialog I have set the optionsEX to [ofExNoPlacesBar] and that removes the bar that would let them select folders and directories to go to quickly but the user can use the bread crumb address tool to go up a level and type a different directory into the filename text box to change directories.
Thank you
If you are using Delphi 2009+, there is a TFileOpenDialog. Use this, and set
procedure TForm3.FileOpenDialog1FolderChange(Sender: TObject);
begin
FInitiated := true;
end;
procedure TForm3.FileOpenDialog1FolderChanging(Sender: TObject;
var CanChange: Boolean);
begin
CanChange := not FInitiated;
end;
procedure TForm3.btnOpenClick(Sender: TObject);
begin
FInitiated := false;
FileOpenDialog1.DefaultFolder := 'C:\MyFolder\';
FileOpenDialog1.Execute;
end;
where
var
FInitiated: boolean;
(Notice that there should be exactly one FInitiated per TFileOpenDialog. So, if FileOpenDialog is a private member of TForm3, let FInitiated be a private member of TForm3 as well.)
To improve the user experience, you will probably use
procedure TForm3.FileOpenDialog1FolderChanging(Sender: TObject;
var CanChange: Boolean);
begin
CanChange := not FInitiated;
if not CanChange then beep;
end;
or
procedure TForm3.FileOpenDialog1FolderChanging(Sender: TObject;
var CanChange: Boolean);
begin
CanChange := not FInitiated;
if not CanChange then
MessageBox(Handle, PChar('Directory selection is not allowed.'), PChar(Caption), MB_ICONINFORMATION);
end;
Use a different open dialog (make a form yourself with no folder navigation, only a file list box), or simply audit for a path not matching the initial dir and refuse to actually open the file.
The 'FileOpenDialog' has an OnFolderChanging event of type TFileDialogFolderChangingEvent which have a boolean CanChange parameter. I'd expect setting this parameter to false would serve the purpose.
edit:
Example usage as per Remy's comments (if I understood correctly);
procedure TForm1.FileOpenDialog1FolderChanging(Sender: TObject;
var CanChange: Boolean);
var
Dlg: TFileOpenDialog;
DefFolder: IShellItem;
iOrder: Integer;
begin
CanChange := False;
Dlg := Sender as TFileOpenDialog;
if Succeeded(SHCreateItemFromParsingName(PWideChar(WideString(Dlg.DefaultFolder)), nil, IShellItem, DefFolder)) then
try
CanChange := Dlg.ShellItem.Compare(DefFolder, SICHINT_ALLFIELDS, iOrder) = S_OK;
finally
DefFolder := nil;
end;
end;
The below also works but more vulnerable to path variations (see Andreas' comments below);
procedure TForm1.FileOpenDialog1FolderChanging(Sender: TObject;
var CanChange: Boolean);
begin
CanChange := SameFileName(TFileOpenDialog(Sender).FileName,
TFileOpenDialog(Sender).DefaultFolder);
end;