gonzales

Пользователи
  • Публикаций

    78
  • Зарегистрирован

  • Посещение

  • Победитель дней

    1

gonzales стал победителем дня 4 января 2015

gonzales имел наиболее популярный контент!

Информация о gonzales

  • Звание
    Продвинутый пользователь

Посетители профиля

604 просмотра профиля
  1. gonzales

    SIP клиент

    Доброго всем дня! Ищу компонент для SIP телефонии для Андроид и iOS под Firemonkey. Или ищу разработчика, способного написать такой))) Всем заранее спасибо за ответы!!!
  2. Я же писал, флаг FreeOnTerminate стоит, но не отрабатывает в Андроид. Поэтому пришлось убивать
  3. Помогло Thread.IdHTTP.Disconnect; Thread.Terminate; Thread:=nil; Thread.Free;
  4. Ну так я это и хочу сделать. Прикольно, ща попробую.
  5. С potok.terminated не понял, почему так, ведь при создании выставил флаг freeonterminate. По идее все должно быть, может конечно он не отрабатывает.
  6. DisposeOf к сожалению я не могу использовать, так как надо уничтожить объект при нажатии на него самого. Поэтому использую Release, как отложенный деструктор, как только объект освободится, он будет уничтожен.
  7. Доброго времени суток! Не знаю, в какой раздел правильнее написать, потому как проблема из разных областей. Собственно проблема в следующем Есть базовый класс, TEssence type TEssence = class(TRectangle) private procedure EssenceMouseEnter(Sender: TObject); procedure EssenceMouseLeave(Sender: TObject); public EssenceName: TLabel; EssenceImage: TImage; ImageSize: integer; constructor Create(AOwner: TComponent); Overload; constructor CreateCustom(AOwner: TComponent; X: Single; Y: Single; W: Single; H: Single; R: Single; Str_T: Single; Str_C: cardinal; Fill_C: cardinal; FontColor: cardinal; FontSize: Single; Im_size: Single; text: string); Overload; destructor Destroy; Overload; procedure SetName(Name: string); procedure SetIcon(iconnumber: integer); end; Есть наследники от базового класса. Среди них есть есть класс TCamera type TCamera = class(TEssence) public Thread: TCameraThread; Camera_id: byte; Snapshot_url: string; GetRecords_url: string; Record_url: string; DelFile_url: string; Camera_Image: TImage; CameraActive: boolean; CameraValue: TCircle; buttonLayout: TLayout; DetailsButton: TButton; RecordsCount: integer; RecordsArray: array of String; constructor Create(AOwner: TComponent); Overload; constructor CreateCustom(AOwner: TComponent; X: Single; Y: Single; W: Single; H: Single; R: Single; Str_T: Single; Str_C: cardinal; Fill_C: cardinal; FontColor: cardinal; FontSize: Single; Im_size: Single; text: string); Overload; destructor Destroy; Overload; procedure CameraSetURL; procedure StartCamera; procedure StopCamera; procedure CameraClick(Sender: TObject); procedure CameraRestart(Sender: TObject); procedure DownloadClick(Sender: TObject); procedure DeleteClick(Sender: TObject); procedure DetailClick(Sender: TObject); end; destructor TCamera.Destroy; begin StopCamera; buttonLayout.Release; CameraValue.Release; inherited; end; procedure TCamera.StopCamera; begin if Thread<>nil then begin Thread.IdHTTP.Disconnect; Thread.Terminate; end; if Camera_Image<>nil then begin Camera_Image.Release; Camera_Image := nil; CameraActive := false; SetLength(RecordsArray, 0); end; end; Он отличается от других подобных, что в при создании экземпляра в нем создается поток TCameraThread, в котором я получаю изображение с камеры. type TCameraThread = class(TThread) private aStream: TMemoryStream; newStream: TMemoryStream; public IdConnection: TIdConnectionIntercept; IdHTTP: TIdHTTP; url: string; bmp: tbitmap; constructor Create(abmp: tbitmap); Overload; destructor Destroy; Overload; procedure Execute; override; procedure Receive(ASender: TIdConnectionIntercept; var ABuffer: TIdBytes); end; constructor TCameraThread.Create(abmp: tbitmap); // (abmp: tbitmap; aurl: string); begin inherited Create(true); bmp := abmp; FreeOnTerminate := true; aStream := TMemoryStream.Create; newStream := TMemoryStream.Create; IdHTTP := TIdHTTP.Create; IdConnection := TIdConnectionIntercept.Create; IdHTTP.Intercept := IdConnection; IdConnection.OnReceive := Receive; end; destructor TCameraThread.Destroy; begin bmp.Free; bmp:=nil; aStream.Free; aStream:=nil; newStream.Free; newStream:=nil; IdHTTP.Free; IdHTTP:=nil; IdConnection.Free; IdConnection:=nil; inherited; end; И есть процедура FreeRoom, которой я пользуюсь для того, чтобы убивать все элементы procedure TForm1.FreeRoom; var i: integer; begin Form1.MasterTimer.Enabled := false; for i := Form1.RoomsScrollBox.ComponentCount - 1 downto 0 do begin if Form1.RoomsScrollBox.Components[i] is TEssence then begin (Form1.RoomsScrollBox.Components[i] as TEssence).Release; end; end; SetLength(Form1.RoomElements, 0); CurrentRoomElement := 0; end; Я всегда думал, что при такой конструкции будет следующий порядок, вызовется деструктор TCamera, в котором сработает функция StopCamera, которая остановит и уничтожит поток и уничтожится экземпляр класса TCamera. И все это нормально (наверное) работало до тех пор, пока я не прикрутил сервис IFMXApplicationEventService. Задача была крайне простой, при сворачивании приложения уничтожить все объекты и потоки, а при разворачивании опять все запустить. Соответственно была сделана вот такая простая контрукция procedure TForm1.FormCreate(Sender: TObject); var aFMXApplicationEventService: IFMXApplicationEventService; begin if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(aFMXApplicationEventService)) then aFMXApplicationEventService.SetApplicationEventHandler(HandleAppEvent); end; function TForm1.HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): boolean; begin case AAppEvent of TApplicationEvent.BecameActive: begin Form1.CheckDefaultRoom; end; TApplicationEvent.WillBecomeInactive: begin MasterTimer.Enabled := false; Form1.FreeRoom; end; end; Result := true; end; Но происходит странное. Если у меня есть экземпляр TCamera с потоком внутри, то сворачивается приложение нормально, но уже не разворачивается, просто висит в памяти, или показывает черный экран. Если среди объектов нет TCamera, то все отрабатывает правильно. Судя по всему дело именно в потоке, который каким-то образом валит приложение. Еще одна странность, что я не могу отдебажить приложение, я поставил точку остановки на деструкторе, но программа не останавливается в нем, причем не только в Андроид, но и в винде. Третий день уже бьюсь, подскажите, кто чем может, буду признателен за любую информацию. Заранее спасибо!
  8. gonzales

    Пуши в IOS

    Так а в чем конкретно проблема? В коде есть OnReceiveNotificationEvent - вызывается когда придет пуш. Соответственно вместо ShowMessage(aText); пишите вызов новой формы. Если она уже создана, то просто FormB.visible:=true;, если не создана, то вызов конструктора, (примерно так FormB:=TForm.Create;, соответственно конструктор должен быть описан)
  9. gonzales

    Пуши в IOS

    Все правильно, так и работает. При публикации в аппсторе sandbox (песочница) надо снять
  10. Забыл уточнить, что во втором варианте программа вообще завешивается))))
  11. Доброго времени суток! Столкнулся с задачей организовать прием MJPEG c ip-камеры. Само по себе все работает. На кнопке висит GET запрос в камеру procedure TForm1.FormCreate(Sender: TObject); begin FReceivedData := TMemoryStream.Create; FParsedData := TMemoryStream.Create; end; procedure TForm1.DeleteStream(Stream: TMemoryStream; Amount: Integer); var bufStream: TMemoryStream; newSize: int64; begin bufStream := TMemoryStream.Create; // Check size if (Amount < 0) then Amount := 0 else if Amount > Stream.Size then Amount := Stream.Size; Stream.Position := Amount; newSize := Stream.Size - Amount; bufStream.SetSize(newSize); bufStream.Position := 0; bufStream.CopyFrom(Stream, newSize); Stream.Clear; Stream.SetSize(newSize); Stream.Position := 0; bufStream.Position := 0; Stream.CopyFrom(bufStream, newSize); bufStream.Free; bufStream := nil; end; procedure TForm1.Button6Click(Sender: TObject); begin IdHTTP1.Get('http://192.168.0.9/videostream.cgi?user=admin&pwd=888888', FReceivedData); end; На форме idHTTP, idIOHandler и IdConnectionIntercept У IdConnectionIntercept есть метод OnReceive. procedure TForm1.IdConnectionInterceptReceive(ASender: TIdConnectionIntercept; var ABuffer: TIdBytes); begin Form1.ParseJPEGData; end; procedure TForm1.ParseJPEGData; var i: Integer; StartPos, EndPos: Integer; StartPt: Pointer; Data, DataNext: PByte; Amount: Integer; buffer: TBytes; begin // Check size if (FReceivedData.Size < 2) then Exit; // Initialize Amount := 0; StartPos := -1; StartPt := nil; // Data pointers Data := FReceivedData.Memory; DataNext := Data; Inc(DataNext); try // Parsing loop for i := 0 to FReceivedData.Size - 2 do begin // Check if we have found the start code if (StartPos = -1) and (Data^ = $FF) and (DataNext^ = $D8) then begin StartPos := i; StartPt := Data; end // Check if we have found the JPEG end code else if (StartPos >= 0) and (Data^ = $FF) and (DataNext^ = $D9) then begin // End position EndPos := i; // Copy data (Higher performance than passing whole stream to load, // because FBitmap.LoadFromStream will create a memory stream and copy // everything if Position <> 0 FReceivedData.Position := StartPos; FParsedData.SetSize((EndPos + 2) - StartPos); FParsedData.Position := 0; FParsedData.CopyFrom(FReceivedData, (EndPos + 2) - StartPos); // CopyMemory(FParsedData.Memory, StartPt, (EndPos + 2) - StartPos); // Load bitmap on screen Image1.Bitmap.LoadFromStream(FParsedData); FParsedData.Clear; Application.ProcessMessages; // Amount of data to delete Amount := EndPos + 2; // Reset StartPos := -1; StartPt := nil; end; // Next pointer Inc(Data); Inc(DataNext); end; // Delete the amount of parsed data // FReceivedData.Delete(Amount); DeleteStream(FReceivedData, Amount); FReceivedData.Position := FReceivedData.Size; Application.ProcessMessages; except FReceivedData.Clear; end; end; Так все работает, но сильно грузит основной поток, так что даже программу нельзя закрыть. Подумал, что может вынести процедуру ParseJPEGData в поток. Но что-то не срабатывает. Вот код, прокомментируйте пожалуйста procedure TForm1.ParseJPEGDataThread; begin TTask.Run( procedure var aStream, newStream: TMemoryStream; i: Integer; StartPos, EndPos: Integer; StartPt: Pointer; Data, DataNext: PByte; Amount: Integer; begin aStream := TMemoryStream.Create; newStream := TMemoryStream.Create; TThread.Synchronize(TThread.CurrentThread, procedure begin aStream.CopyFrom(FReceivedData, FReceivedData.Size); end); try if (aStream.Size < 2) then Exit; // Initialize Amount := 0; StartPos := -1; StartPt := nil; // Data pointers Data := aStream.Memory; DataNext := Data; Inc(DataNext); try // Parsing loop for i := 0 to aStream.Size - 2 do begin // Check if we have found the start code if (StartPos = -1) and (Data^ = $FF) and (DataNext^ = $D8) then begin StartPos := i; StartPt := Data; end // Check if we have found the JPEG end code else if (StartPos >= 0) and (Data^ = $FF) and (DataNext^ = $D9) then begin // End position EndPos := i; // Copy data (Higher performance than passing whole stream to load, // because FBitmap.LoadFromStream will create a memory stream and copy // everything if Position <> 0 aStream.Position := StartPos; newStream.SetSize((EndPos + 2) - StartPos); newStream.Position := 0; newStream.CopyFrom(aStream, (EndPos + 2) - StartPos); TThread.Synchronize(TThread.CurrentThread, procedure begin Image1.Bitmap.LoadFromStream(newStream); end); // Load bitmap on screen newStream.Clear; Application.ProcessMessages; // Amount of data to delete Amount := EndPos + 2; // Reset StartPos := -1; StartPt := nil; end; // Next pointer Inc(Data); Inc(DataNext); end; // Delete the amount of parsed data // FReceivedData.Delete(Amount); TThread.Synchronize(TThread.CurrentThread, procedure begin DeleteStream(FReceivedData, Amount); FReceivedData.Position := FReceivedData.Size; end); except TThread.Synchronize(TThread.CurrentThread, procedure begin FReceivedData.Clear; end); end; finally FreeAndNil(aStream); FreeAndNil(newStream); end; end) end;
  12. gonzales

    Пуши в IOS

    Еще доп. накину на вентилятор, вдруг кому пригодится. Чтобы в iOS появилась наклейка с цифрой на иконке программы нужно добавить в JSON запроса пуша в объект notification пару badge=цифра
  13. gonzales

    Не отображается Splash форма на iOS

    На всякий случай кидаю ответ. Все остальное в iOS не работает вот статейка вообще конечно костыль, но по другому добиться нормального splashScreen в iOS у меня не получилось
  14. gonzales

    Пуши в IOS

    Вопрос решился. Есть одно дополнение в код ZyBy Если необходимо обработать сообщение внутри программы правильный код будет такой // это событие срабатывает при открытом приложении {$IFDEF ANDROID} // устраняем ошибку с чтением текста уведомления, // если уведомление отправлено из консоли firebase // и не заполнены дополнительные поля (message, title) aObj := ANotification.DataObject.GetValue(GCMSignature); if aObj <> nil then aText := aObj.value else aText := ANotification.DataObject.GetValue(FCMSignature).value; {$ENDIF} {$IFDEF IOS } aObj := ANotification.DataObject.GetValue(APNsSignature); if aObj <> nil then aText := (aObj as TJSONObject).GetValue('body').Value; {$ENDIF}
  15. gonzales

    Пуши в IOS

    Вот процедура конвертации токена APN в FCM uses // RTL System.Net.HttpClient, System.Net.URLClient, System.NetConsts, System.Threading, // REST REST.Types; const cSandboxValues: array[Boolean] of string = ('false', 'true'); cHTTPResultOK = 200; cFCMIIDBatchImportURL = 'https://iid.googleapis.com/iid/v1:batchImport'; cFCMAuthorizationHeader = 'Authorization'; cFCMAuthorizationHeaderValuePair = 'key=%s'; cResultsValueName = 'results'; cStatusValueName = 'status'; cRegistrationTokenValueName = 'registration_token'; cStatusValueOK = 'OK'; cFCMResultError = 'FCM Result Error: %s'; cFCMJSONError = 'FCM Unexpected JSON: %s'; cHTTPError = 'HTTP Error: %s. Response: %s'; cFCMRequestJSONTemplate = '{ "application": "%s", "sandbox": %s, "apns_tokens": [ "%s" ] }'; AAppBundleID = 'xxxxxxxxx'; AServerKey = 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'; procedure TForm1.Button2Click(Sender: TObject); var ARequest: string; LStream: TStream; LHTTP: THTTPClient; LResponse: IHTTPResponse; begin ARequest:=Format(cFCMRequestJSONTemplate, [AAppBundleID, cSandboxValues[true], Edit1.Text]); LStream := TStringStream.Create(ARequest); LHTTP := THTTPClient.Create; try LHTTP.CustomHeaders[cFCMAuthorizationHeader] := Format(cFCMAuthorizationHeaderValuePair, [AServerKey]); LHTTP.ContentType := CONTENTTYPE_APPLICATION_JSON; LResponse := LHTTP.Post(cFCMIIDBatchImportURL, LStream); if LResponse.StatusCode = cHTTPResultOK then Memo2.Lines.Add(LResponse.ContentAsString); finally LHTTP.Free; end; LStream.Free; end;