Доска почета


Popular Content

Showing most liked content since 17.11.2017 Во всех областях

  1. 11 likes
    Сделал простой пример приложения рации в локальной сети под Android. Реализация через UDP. Буду рад, если кому окажется полезным. Для начала/окончания сеанса связи нужно нажать на окружность Для проверки нужно 2 телефона unit Unit5; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, IdUDPServer, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient, IdGlobal, IdSocketHandle, Androidapi.JNI.Media, Androidapi.JNI.JavaTypes, Androidapi.JNIBridge, AndroidApi.JNI, AndroidApi.Helpers, FMX.Objects, System.Math; type TForm1 = class(TForm) Circle: TCircle; procedure ServerUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); procedure FormCreate(Sender: TObject); procedure CircleTap(Sender: TObject; const Point: TPointF); end; TSendThread = class(TThread) protected procedure Execute; override; end; var Form1: TForm1; SendThread: TSendThread; Server: TIdUDPServer; audioRecord: JaudioRecord; audiotrack: JAudioTrack; recording: boolean; buffer_Size, port,ch_in, ch_out, format, freq, source: integer; implementation {$R *.fmx} procedure TSendThread.Execute; var buffer: TJavaArray<Byte>; begin buffer := TJavaArray<Byte>.create(buffer_size); while recording do begin audioRecord.read(buffer,0,buffer_size); Server.Broadcast(TIDBytes(TJavaArrayToTBytes(buffer)),port); end; buffer.Free; end; procedure TForm1.CircleTap(Sender: TObject; const Point: TPointF); begin recording:= not recording; if recording then begin Circle.Fill.Color:=TAlphaColors.Red; Server.OnUDPRead:=nil; audiorecord.startRecording; SendThread:=TSendThread.Create; end else begin Circle.Fill.Color:=TAlphaColors.Gray; audiorecord.stop; Server.OnUDPRead:=ServerUDPRead; end; end; procedure TForm1.FormCreate(Sender: TObject); begin buffer_size:=2048; freq:=8000; port:=5555; Server:=TIdUdpServer.Create(Form1); with Server do begin BufferSize:=buffer_size; DefaultPort:=port; BroadCastEnabled:=true; Active:=true; OnUDPRead:=ServerUDPRead; end; Circle.Width:=min(Screen.Width,Screen.Height)*0.7; Circle.Height:=Circle.Width; ch_in:=TJAudioFormat.JavaClass.CHANNEL_IN_MONO; ch_out:=TJAudioFormat.JavaClass.CHANNEL_OUT_MONO; format:=TJAudioFormat.JavaClass.ENCODING_PCM_16BIT; source:=TJMediaRecorder_AudioSource.JavaClass.MIC; audioRecord := TJAudioRecord.JavaClass.init(source, freq, ch_in, format, buffer_size); audiotrack:=TJAudioTrack.JavaClass.init(3, freq, ch_out, format, buffer_size,1); end; procedure TForm1.ServerUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); begin audiotrack.write(TBytesToTJavaArray(TBytes(AData)),0,Length(AData)); audiotrack.play; end; end. radio.zip
  2. 3 likes
    procedure RunProgram(cmdStr:string; Wait:Boolean; ShowWindow:Word); var si:TStartupInfo; pi:TProcessInformation; s:string; begin FillChar(si, SizeOf(si), 0); si.cb := SizeOf(si); si.dwFlags:=STARTF_USESHOWWINDOW; si.wShowWindow := ShowWindow; s:=cmdStr; UniqueString(s); getlasterror; if not CreateProcess(nil, PChar(S), NIL, NIL, False, 0, NIL, NIL, si, pi) then showMessageFmt('Ошибка %d. %s',[getlasterror,SysErrorMessage(getlasterror)]); if wait then WaitForSingleObject(pi.hProcess, INFINITE); CloseHandle(pi.hProcess); CloseHandle(pi.hThread); end;
  3. 3 likes
    Можете мне сделать тестовый сервер и клиент, чтобы я смог у себя проверить? Тогда мой ответ будет более детальным. А пока: Какой вы объем данных шлете по соединению? Чем вызвана потребность использовать именно сокеты? TimeOut никогда не ставьте большими. Indy работает по принципу блокировки сокета и всего потока в целом. Поэтому большое значение = зависание всего приложения = нежелательные результаты и зависание. Я ставил 100 мс для работы с маленькими пакетами. С такой задержкой доп. поток не обязателен. Если значения более 500 мс - нужно создавать отдельный поток и работать с сокетами в ней + синхронизация при обработке / отправке данных. TIdTCPClient на Andoid любит спать и не проверять входящий буфер. Поэтому вручную нужно вызывать по таймеру проверку типа: procedure T<какое-то имя класа>.Read; var sz : integer; lMsg : string; begin try TMonitor.Enter(Self); try if not Assigned(Client.IOHandler) then Exit; //Client = TIdTCPClient if Client.IOHandler.InputBufferIsEmpty then begin if not Client.IOHandler.CheckForDataOnSource() then exit; end; sz := Client.IOHandler.InputBuffer.Size; if sz <= 0 then exit; lMsg := Client.IOHandler.InputBuffer.ExtractToString(-1, IndyTextEncoding_UTF8); Client.IOHandler.InputBuffer.Clear; <какой-то обработчик входящего сообщения>; except on e : Exception do <какой-то обработчик ошибки>; end; finally TMonitor.Exit(Self); end; end; AntiFreeze - это мягко говоря "костыль" от Indy, использование его плохая практика. На мобильной платформе вряд ли он появится, хотя и реализуется не сложно.
  4. 3 likes
    Там адаптировать нечего, всего 2 изменения в файле FMX.TKRBarCodeScanner.pas. 1. // было uses System.Classes {$IFDEF IOS} ,FMX.TMSZBarReader {$ENDIF} {$IFDEF ANDROID} ,FMX.Platform, FMX.Helpers.Android, System.Rtti, FMX.Types, System.SysUtils, Androidapi.JNI.GraphicsContentViewText, Androidapi.JNI.JavaTypes, FMX.StdCtrls, FMX.Edit {$ENDIF} ; // стало uses System.Classes {$IFDEF IOS} ,FMX.TMSZBarReader {$ENDIF} {$IFDEF ANDROID} ,FMX.Platform, FMX.Helpers.Android, System.Rtti, FMX.Types, System.SysUtils, Androidapi.JNI.GraphicsContentViewText, Androidapi.JNI.JavaTypes, FMX.StdCtrls, FMX.Edit {$IF CompilerVersion >= 20} ,Androidapi.Helpers {$ENDIF} {$ENDIF} ; 2 // было {$IFDEF ANDROID} function TTKRBarCodeScanner.HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean; begin Result := False; if FMonitorClipboard and (AAppEvent = aeBecameActive) then begin Result := GetBarcodeValue; end; end; {$ENDIF} // стало {$IFDEF ANDROID} function TTKRBarCodeScanner.HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean; begin Result := False; if FMonitorClipboard and (AAppEvent = {$IF CompilerVersion >= 20}TApplicationEvent.{$ENDIF}aeBecameActive) then begin Result := GetBarcodeValue; end; end; {$ENDIF}
  5. 2 likes
    with Server do begin BufferSize:=buffersize ??? with Server do begin BufferSize:=buffer_size
  6. 2 likes
  7. 2 likes
    Посмотрел ваш пример, все зависания и вылеты с ошибками связаны с обращением к пустым объектам, попыткой обработать все в одном обработчике. Исправить клиент дело не благодарное, поэтому сделал пример по работе с TCP сокетом с возможностью автоподключения (тык). Проверил на нескольких устройствах, полет нормальный. Основные замечания: Не используйте FormActivate событие, тем более на мобильной платформе. Его обработка замораживает приложение. В примере посмотрите вариант обхода. TIniFile нет смысла использовать каждый раз для считывания настроек. 1 раз считали при старте приложения и больше к файлу не обращаемся. Хранить настройки в компонентах (edSettingHost.Text и т.п.). Создание свойства отнимет максимум минуту, а выгоду даст существенную. TCP сокет соединения следуют принимать как асинхронные, а не как запрос-ответ. Это предусматривает получение команды сервером, какое-то выполнение и лишь потом отправка на клиент. Поэтому попробуйте отказаться от использования GetFromServer. Сервер только запускал для проверки клиента, пару раз ловил outofmemory и access violation, закрыться тоже не захотел по-хорошему. Поэтому желательно его тоже довести до ума.
  8. 2 likes
    Подобное поведение наблюдалось на Delphi 10.2. Вроде этот баг исправили в 10.2.1, хотя могу ошибаться... Если нет, то возвращайтесь пока на 10.1.2 (Berlin upd 2). О том как и когда ловить события я писал здесь: Очередь событий Delphi приложения на Android Обратите внимание на события: BecameActive, WillBecomeForeground, WillBecomeInactive, OnSaveState
  9. 2 likes
  10. 2 likes
    Не только должна, но и отлично работает. Вот пример: function TFormMain.CreateUDPServer : Boolean; Var I : Integer; begin Result:=False; IdUDPServer:=TIdUDPServer.Create; IdUDPServer.BroadcastEnabled:=True; IdUDPServer.OnUDPRead:=IdUDPServerUDPRead; for I := Low(UDPPortArray) to High(UDPPortArray) do begin IdUDPServer.Bindings.Clear; with IdUDPServer.Bindings.Add do begin IP:='0.0.0.0'; Port:=UDPPortArray[I]; end; try IdUDPServer.Active:=True; except end; if IdUDPServer.Active then begin FActiveUDPPort:=IdUDPServer.Bindings.Items[0].Port; IPMACLocalPair.Port:=IdUDPServer.Bindings.Items[0].Port; Result:=True; Exit; end; end; FActiveUDPPort:=-1; end; procedure TFormMain.IdUDPServerUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); Var S : String; begin if (IPMACLocalPair.IP.Equals(ABinding.PeerIP)) And (IPMACLocalPair.Port=ABinding.PeerPort) then exit; DateTimeToString(S, 'hh:nn:ss.zzz', Now); S:=S+' '+BytesToString(AData , IndyUTF8Encoding); S:=S+' | from '+ABinding.PeerIP+':'+ABinding.PeerPort.ToString; Memo.Lines.Insert(0,S); end; На UDPPortArray не обращайте внимание, это если порт занят, то используется другой (UDPPortArray : array [0..2] of Integer = (55771, 55772, 55773);). IdUDPServer.BroadcastEnabled:=True; тоже не нужно, если не собираетесь широковещать. Большинство функций работы с TIdBytes доступны в юните idGlobal, как например BytesToString(AData , IndyUTF8Encoding) в моем коде.
  11. 1 like
  12. 1 like
    Блестящая работа! Простой и красивый код! Потеря пакетов обусловлена (скорее всего) статичным buffer_size, на разных устройствах он может быть разным и правильнее его размер получать вот так buffer_size:= TJAudioTrack.JavaClass.getMinBufferSize(PSampleRateHz, TJAudioFormat.JavaClass.CHANNEL_OUT_MONO, TJAudioFormat.JavaClass.ENCODING_PCM_16BIT); if (buffer_size = TJAudioTrack.JavaClass.ERROR) then Exit; if (buffer_size = TJAudioTrack.JavaClass.ERROR_BAD_VALUE) then Exit; Еще конечно бы двойную буферизацию для записи/воспроизведения Так же можно сразу запустить проигрывание audiotrack.play в FormCreate, реальные звуки будут проигрываться и так: procedure TForm1.ServerUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); begin audiotrack.write(TBytesToTJavaArray(TBytes(AData)),0,Length(AData)); end;
  13. 1 like
    CreateProcess, StartupInfo, ProcessInformation, WaitForSingleObject, CloseHandle объявлены в WinAPI. У других операционных систем методы запуска другие.
  14. 1 like
    To Rusland Тут, видимо, на месте уголков надо явно задать адрес сервера... Я, по крайней мере, так и сделал.
  15. 1 like
    И всё же таймер должен идти лесом. Отчего не сделать поток? procedure TMyThread.Execute; begin while not Terminated do begin try if (not IdTCPClient1.Connected) then begin IdTCPClient1.Connect; end; except Sleep(500); continue; end; // а тут если коннект есть уже выгребаем что и как надо ... А запросы серверу из главного потока. Функции запроса можно также в классе потока реализовать для нахождения этого тисипишного функционала в одном месте TMyThread = class(TThread) private protected procedure Execute; override; public IdTCPClient1: TIdTCPClient; function SendPacket(ip: String): Boolean; // это вызываем из главного потока если надо на сервер что-то послать constructor Create(host: String; port: Integer; toconnect: Integer; toread: Integer); destructor Destory; end;
  16. 1 like
    без привязки к платформе, т.к. он работает с апи yandex и google а выводить можно куда захотите, я выводил на TMapView для мобильных, на Windows можно использовать какой-нить другой компонент
This leaderboard is set to Москва/GMT+03:00