ENERGY

Кто просил PHP код, для отправки пушей, без лимита на 1000 токенов за одну отправку. 

Вот готовый вариант: 

<?php         
                                                                                      
$server_key = 'AAAAnCw-yKA:APA91bEYphFbq_w...';

$title = 'Title';
$text = 'test';
$limit = 999;
$field_name = 'DeviceToken';

   $sql = mysqli_connect("mysqlserver.com", "DBName", "DBPassword");
   /* check connection */
   if (mysqli_connect_errno()) {
    printf("Connect failed: %s\n", mysqli_connect_error());
    exit();
}
   
   $offset = 0;
   while (true) {  
                                                           
   $query = "SELECT $field_name FROM `DBName`.`TableName` LIMIT $limit OFFSET $offset";
   $result = mysqli_query($sql, $query);                 
   if (!$result) {
    die('Invalid query: ' . mysql_error());
} 
   if (mysqli_num_rows($result) == 0) {
     echo "{\"result\":true}";  
     exit;    
   }
  $arr = array();  
  while ($row = mysqli_fetch_array($result, MYSQL_ASSOC)) {
    $arr[] =  $row["$field_name"];  
   }
   
  pushSend($title, $text, $arr, $server_key); 


  $offset = $offset + $limit;
  /* free result set */
  mysqli_free_result($result);  


 //  foreach($arr as $item) {
 //    echo $item, '<br>';
//}

//echo '-----------<br>';

}

mysqli_close($sql);
         
       

// max 1000
 
function pushSend($title, $text, $tokens, $server_key) {
    $url = 'https://fcm.googleapis.com/fcm/send';
    $headers = array('Authorization: key=' . $server_key, 
     'Content-Type: application/json');
  
    if (is_array($tokens))
      $fields['registration_ids'] = $tokens;
    else
      $fields['registration_ids'] = array($tokens);
  
    $fields['priority'] = 'high';
    $fields['notification'] = array('body' => $text, 'title' => $title);
    $fields['data'] = array('message' => $text, 'title' => $title);
  
    $ch = curl_init();
    curl_setopt_array($ch, array(
            CURLOPT_URL => $url,
            CURLOPT_POST => true,
            CURLOPT_HTTPHEADER => $headers,
            CURLOPT_RETURNTRANSFER => true,
            CURLOPT_SSL_VERIFYHOST => 0,
            CURLOPT_SSL_VERIFYPEER => false,
            CURLOPT_POSTFIELDS => json_encode($fields)
    ));
    $result = curl_exec($ch);
    curl_close($ch);
    return $result;
}
?>

 

Как прочитать все свои сообщения Push, если пришло больше одного сообщения, при старте программы?

Дело в том, что код который на форуме популярен, показывает только одно сообщение, только то, которое выбрано.

Пример: отправляю 3 сообщения, все 3 висят в статус баре, при загрузке программы показывает только то, по которому тапнули из статус бара, остальные игнорит. А мне нужно их все 3 сохранить.

var
  vCurNotification : TPushServiceNotification;

begin
  for vCurNotification in fPushService.StartupNotifications do
  begin
    OnReceiveNotificationEvent(Self, vCurNotification)
  end;

end;

 

Push сервис получаю так, как указано в статье Равиля:

procedure TPushNotify.UpdateConnection;
begin
  fPushService := nil;
  fPushServiceConnection := nil;
  {$IF defined(ANDROID)}
  fPushService := TPushServiceManager.Instance.GetServiceByName(TPushService.TServiceNames.GCM);
  fPushService.AppProps[TPushService.TAppPropNames.GCMAppID] := ServerSenderID;
{$ENDIF}
{$IF defined(IOS) AND defined(CPUARM)}
  fPushService := TPushServiceManager.Instance.GetServiceByName
   (TPushService.TServiceNames.APS);
{$ENDIF}
  if Assigned(fPushService) then
  begin
    fPushServiceConnection := TPushServiceConnection.Create(FPushService);
    fPushServiceConnection.OnChange := OnServiceConnectionChange;
    fPushServiceConnection.OnReceiveNotification := OnReceiveNotificationEvent;
    fPushServiceConnection.Active := true;
  end;
end;

 

ОК, выберем такое поведение - пусть юзер выбирает каждое сообщение, тапнув по нему в статус баре и читает его в программе. Я бы и так сделал, но тогда возникает проблема с очисткой в статус баре. Я так понял сообщения можно удалить только все (CancelAll) - т.е. юзер тапнул на одно сообщение, прочитал и затем программа очистила все остальные.. Вот в чем проблема. Странно почему нет нормального механизма..

 

@krapotkin
TNotificationCenter.Create(nil).CancelAll;

Это же утечка памяти. Надо уничтожать объект.

Хотя по идее нет, в ARC компиляторах он должен сам уничтожится.

 

@Равиль Зарипов (ZuBy) по поводу вашей статьи: 

В коде отправлять токен на базу нужно только в событии OnChange , которое срабатывает в момент вызова FPushServiceConnection.Active := true; Если вы отправляете на базу в OnChange, а затем еще и в TFormMain.PushServiceRegister; - то данные отправятся 2 раза. Device ID и Token конечно же будут одинаковые. Т.е. проще говоря после строки FPushServiceConnection.Active := true; не должно идти никакого кода. Я проверил в отладчике на 4 и 5 Android.

 

 

procedure TFormMain.PushServiceRegister;

Под отладчиком запускали?

Удалите программу с Андроид. 

Сделайте Clean проекту. Запустите (Run) еще раз.

Какая модель девайса?

Новый пустой проект запускается?

 

@Евгений Корепов

Хотел спросить, флаг Active  выставляется когда Firebase вернул ошибку на конкретный токен, верно?

А в каком случае он ошибку может возвращать, может он вернет ее если телефон будет выключен, или давно не выходил в сеть. Т.е. необязательно это означает что приложение удалили.

И кстати можно же не отправлять в скрипте на такие телефоны сообщение, ведь телефон не зарегистрировался (при регистрации флаг ставиться)

 

Кстати вот https://firebase.google.com/docs/cloud-messaging/server

"error": "Unavailable" 
"error": "InvalidRegistration" 
"error": "NotRegistered"

 

Пожалуйста проголосуйте. Думаю это всех касается, т.к. проблема связана и с TImageList и с TImage. 

https://quality.embarcadero.com/browse/RSP-18210

4 часа назад, krapotkin сказал:

ну вот и ответ почему никто не сталкивался )))

сейчас все в PNG изначально картинки юзают 

Я использую только PNG и эта проблема связана именно с png картинками (с jpeg такой проблемы нет, я проверил только что).

1 час назад, RoschinSpb сказал:

На баги лучше реагируют на те, которые от официальных юзеров. На баги от работников, тем более бывших реагируют плохо.

У меня пиратка, но если вы не сможете запостить, тогда я сам отправлю.

Мне просто показалось что вы смогли бы технически лучше меня объяснить причину.

@RoschinSpb

Сетка появляется на всех картинках, без исключения, посмотрите выше, там была оранжевая картинка. Просто на цветных картинках она не сразу "проявляется", а постепенно.

Может вы запостите баг? Просто, вы лучше объясните вероятную причину этого явления, т.к. знаете этот компонент и внутренности FMX гораздо лучше меня, а мы поддержим голосами. Да и к вам будет больше доверия, т.к. вы FireMonkey разработчик, возможно баг сразу запуститься в обработку.

Картинки портятся только при работе в Design Time - так что это в любом случае касается всех платформ. В уже скомпилированной программе они вроде не портятся, если конечно не были до этого испорчены в design time, но не проверял.

При переключении с соты на соту параметры сети могут меняться. Компонент на это не стабильно реагирует, и может порушить всю программу. Поищите как делать get запрос.

Посмотрите проект Равиля: https://github.com/rzaripov1990/ModernListView

Здесь есть все что вам надо.

@RoschinSpb

Может запостить баг? Или он уже есть?

 

Цитата

Да, странная картина, еще более странно, что ни кто не замечал такого поведения.

Я кстати думал что про него уже все давно знают.. Просто нет времени.. 

Между прочим картинка  в Timage тоже портится со временем в Design Time.

@Евгений Корепов

По поводу функции AnalyzeResponse -  у вас просто ставиться флаг неактивности, а что если сразу удалять из базы этот ID ?

А токен который генерится на телефоне, он постоянный? Или его нужно каждый раз при старте приложения записывать в базу?

Вот сейчас кинул новый чистый список, решил добавить иконки только размером 48x48. Начал добавлять, и уже на 3 иконке начала появляться сетка на уже добавленных иконках. Я даже дизайнер ImageList не закрывал.

 

Я приаттачил зип файл с иконками 48x48, возможно кто-то может проверить у себя, возможно этот баг только у меня? Спасибо.

new.zip

 

Решение проблемы пока такое:

Добавляем картинки в ресурсы, и при старте в OnCreate DataModule загружаем их из ресурсов в ImageList.

 

 

unit DataModule;

interface

uses
  System.SysUtils, System.Classes, FMX.Types, FMX.Controls, System.ImageList, FMX.ImgList,
  FMX.Graphics, System.Types, FMX.MultiResBitmap, System.UITypes;

type
  TImageListHelper = class helper for TImageList
    function Add(aBitmap: TBitmap): integer;
  end;

  TDataMod = class(TDataModule)
    StyleBook: TStyleBook;
    ImageList: TImageList;
    procedure DataModuleCreate(Sender: TObject);
  private
    procedure LoadImagesToImageList;
  public
    { Public declarations }
  end;

var
  gDataMod: TDataMod;

implementation

{%CLASSGROUP 'FMX.Controls.TControl'}

{$R *.dfm}

procedure TDataMod.DataModuleCreate(Sender: TObject);
begin
  LoadImagesToImageList;
end;


// from resource
procedure TDataMod.LoadImagesToImageList;
var
  vBmp: TBitmap;
  i: Integer;

  procedure AddResourceToImageList(const aName: string);
  var
    vRes: TResourceStream;
  begin
    vRes := TResourceStream.Create(hInstance, aName, RT_RCDATA);
    try
      vBmp.LoadFromStream(vRes);
      ImageList.Add(vBmp);
    finally
      vRes.Free;
    end;
  end;

begin
  vBmp := TBitmap.Create;
  ImageList.BeginUpdate;
  try
    for i := 0 to 16 do
    begin
      AddResourceToImageList('i' + i.ToString);
    end;
  finally
    vBmp.Free;
    ImageList.EndUpdate;
  end;
end;

function TImageListHelper.Add(aBitmap: TBitmap): integer;
const
  SCALE = 1;
var
  vSource: TCustomSourceItem;
  vBitmapItem: TCustomBitmapItem;
  vDest: TCustomDestinationItem;
  vLayer: TLayer;
begin
  Result := -1;
  if (aBitmap.Width = 0) or (aBitmap.Height = 0) then exit;

  // add source bitmap
  vSource := Source.Add;
  vSource.MultiResBitmap.TransparentColor := TColorRec.Fuchsia;
  vSource.MultiResBitmap.SizeKind := TSizeKind.Source;
  vSource.MultiResBitmap.Width := Round(aBitmap.Width / SCALE);
  vSource.MultiResBitmap.Height := Round(aBitmap.Height / SCALE);
  vBitmapItem := vSource.MultiResBitmap.ItemByScale(SCALE, True, True);
  if vBitmapItem = nil then
  begin
    vBitmapItem := vSource.MultiResBitmap.Add;
    vBitmapItem.Scale := Scale;
  end;
  vBitmapItem.Bitmap.Assign(aBitmap);

  vDest := Destination.Add;
  vLayer := vDest.Layers.Add;
  vLayer.SourceRect.Rect := TRectF.Create(TPoint.Zero, vSource.MultiResBitmap.Width,
      vSource.MultiResBitmap.Height);
  vLayer.Name := vSource.Name;
  Result := vDest.Index;
end;

end.

 

5 часов назад, krapotkin сказал:

какая сетка в TImageList? как там вообще что рисуется? 

это же просто набор битмапов, из которых по запросу копируются более мелкие битмапы

Вот я сам не знаю. Этот  баг меня преследует давно. У меня кстати dpi 150% в системе (в Design time) может с этим связано? А у вас есть такой баг?

Delphi Berlin Update 2, все картинки png 24 bit

Вот скрин, и точно такая же фигня на релизе.

Вот здесь на скрине я только только обновил все картинки на новые, и линии рисуются сразу после добавления картинки на всех других. Чем больше добавляешь (обновляешь Source), тем четче становятся.

 

 

@RoschinSpb Выручайте пожалуйста, что посоветуете?

Upd:

Пожалуйста проголосуйте. Думаю это всех касается, т.к. проблема связана и с TImageList и с TImage. 

https://quality.embarcadero.com/browse/RSP-18210

 

 

Сейчас столкнулся с большой проблемой перед самым релизом для заказчика..

17 картинок, разного размера. Сейчас в TImageList  сетка рисуется постоянно при обновлении Source каждой картинки. C каждым разом становится сетка четче.  Если раньше я просто обновлял на новые картинки, и таким образом решал проблему, то сейчас после обновления source картинок сетка остается на многих картинках, причем я даже не закрываю TImageList . Только начинаю замещать одни картинки, на других появляется сетка..

И вот что теперь делать незнаю..

 

Да кстати картинки портятся и в TImage со временем в Design Time.

Сетка означает что картинку много раз масштабируют. Но почему не сохраняют оригинал, это мне не понятно..

Что тут можно придумать?

 

Delphi Berlin Update 2

Всю голову уже сломал. 

В Android выпадает TCombobox с popup списком, напротив каждого Item стоит RadioButton,

Как поменять цвет RadioButton, а также цвет выделения на этом списке? По идее это же ListBox? Я не нашел где это можно поменять. 

Я уже полностью поменял цвет встроенного png, все поменялось втч и стандартные Radio Button,  а цвет Radio Button в раскрытом списке TCombobox без изменений.

Где они меняются подскажите пожалуйста?

 

Цитата

Вся "прелесть" решения в том, что Free работает не так как раньше работал Free, а DisposeOf теперь работает так же как раньше работал Free. 

@RoschinSpb

Ну нет же.

В не ARC (Auto reference counter), классическом компиляторе (Windows и Mac)  Free всегда вызывает деструктор и освобождает память выделенную под класс и его поля. Т.е. если обратиться потом к такому классу произойдет исключение AV.

А вот в ARC компиляторах, DisposeOf вызовет деструктор, но память выделенная под класс и его поля, останется занятой, и не освободиться. Т,е. если после DisposeOf обратится к полям класса, не будет исключения AV, но поля уже будут очищены.  При этом в деструкторе можно освободить свои данные и уничтожить инкапсулированные классы.

Такие объекты называют зомби-объекты - т.к. они остаются висеть в памяти до конца работы программы, и даже если ссылка позже на него уменьшиться до 0, память не освободиться и деструктор не будет вызван повторно.  Чтобы узнать находится ли объект в зомби состоянии, есть метод Disposed - это аналог Assign.

Повторюсь всем рекомендую статью GunSmoker, там эта тема хорошо освещена.

 

@Алмаз Амангельды это не то.

 

TPath.GetPublicPath - вернет путь на внешней флешке. Public директория всегда на внешней флешке, если она есть конечно.

GetPublicPath вызывает getExternalFilesDirs на Android.

https://developer.android.com/reference/android/content/Context.html

getExternalFilesDirs(String type)

Returns absolute paths to application-specific directories on all shared/external storage devices where the application can place persistent files it owns.

И вот еще список Path функций для Delphi. 

@dnekrasov

Кстати у меня есть привычка, - методы, которые вызываются в отдельном потоке, к их именам обычно добавлю слово Thread. SetLogoThread. Очень рекомендую от путанницы.

Ну и если спорить дальше, то SetLogo не будет вызван в отдельном потоке, т.к. название метода уже намекает на GUI, а значит только главный поток, и анонимный поток внутри.  

 

 

2 часа назад, dnekrasov сказал:

Это верно только в том случае, если мы заранее знаем, что процедура SetLogo будет всегда вызываться только из основного потока. 

Если так рассуждать, тогда нужно каждое обращение к элементу интерфейса облачать в ForceQueue конструкцию. "А вдруг с другого потока обратятся"?

Имхо "не следует множить сущности без необходимости".

Чтобы помигать кнопкой или любым другим контролом, для привлечения внимания я делаю так: 

Добавить на кнопку TGlowEffect, установить нужный цвет. Внутрь TGlowEffect добавляю TFloatAnimation . В нем выбираю PropertyName = Opacity. Дальше устанавливаю Start и Stop 0 и 1. AutoReverse := true; Loop := true; Duration (0.3)

Все.

В коде включаем :

GlowEffect.Enable := true и FloatAnimation.Enable := true - заставит пульсировать кнопку. 

Например так:

procedure TfrmMain.PulseEMRGButton;
begin
  GlowBtnEMRGNum.Enabled := true;
  animGlowBtn.Enabled := true;
  TThread.CreateAnonymousThread(procedure
  begin
    Sleep(1250);  // general duration
    TThread.Queue(nil, procedure
    begin
      animGlowBtn.Enabled := false;
      GlowBtnEMRGNum.Enabled := false;
    end);
  end).Start;
end;

 

Ксати Major переименуйте тему в "Пульсирующая кнопка".

1 час назад, AliZairov сказал:

Я не до конца понимаю. Вы задали мне вопрос?

@AliZairov

Эта конструкция:

end else
   begin
     T := TThread.CreateAnonymousThread(
     procedure
     begin
       TThread.Synchronize(TThread.CurrentThread,
       procedure()
       begin
         ListView.Items[id].Bitmap.LoadFromFile(Cache + code + '.png');
       end);
     end);
     T.start;
   end;
 end;

равнозначна одной строчке (ее можно заменить:):

ListView.Items[id].Bitmap.LoadFromFile(Cache + code + '.png');

 

TThread.Synchronize - означает "остановить текущий поток, и запустить указанную процедуру в главном (GUI) потоке".

 

 

Еще один момент 

 

 

 except
    MS.Free;  << эта строка не нужна, т.к. код в finally будет выполнен при срабатывании исключения.
  end;
finally
  HTTP.Free;
  MS.Free;
end;

Если вам нужно загасить исключение - то можно сделать пустой блок, без кода. 

try 

except 

end;

Цитата

1) где в настройках DELPHI прописать пути для проекта к файлам, допустим которые находятся здесь:

Эти файлы автоматом подхватываются, в зависимости от выбранной платформы, к зтой папке не надо ничего прописывать и не нужно их копировать в папку с проектом.

По поводу второго вопроса ссылку вам уже дали.

 

А поводу универсального варианта, для всех платформ, аналогичный варианту, который предложил @AliZairov, блин ну вы бы хоть зашли в указанный мною выше топик.

 

uses System.Net.HttpClient

function CheckInternet: boolean;
begin
  Result := false;
  with THTTPClient.Create do
  try
    try
      Result := Head('http://google.com').StatusCode < 400;
    except
    end;
  finally
    Free;
  end;
end;  

Но этот метод работает в несколько раз медленнее, чем вариант для андроида (~200-500 ms, Android метод около 30-50 ms.)

Да кстати  AliZairov в вашем примере утечка памяти (memory leak) - класс уничтожается только в except блоке.

 

1 час назад, Sashar333 сказал:

... Перешел на "Delphi Berlin 10.1 Update 2"

но видимо со вторым вариантом тоже у меня не получится...

... Добавил все PASы в папку для всех USESов которые требовал "Delphi Berlin 10.1 Update 2"

теперь пишет ошибку:

В правой панели выберите платформу Android, а не Windows.