Перейти к содержанию
Fire Monkey от А до Я

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

Пользователи
  • Постов

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

  • Посещение

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

    100

Весь контент Евгений Корепов

  1. Все просто. Надо посмотреть на календарь и обнаружить что на дворе 2017 год. Поэтому всякие: выжечь каленым железом. Только UTF8 нам друг. И еще больший друг он нам если в php скрипте на это указать в начале файла: <?php header('Content-Type: application/json; charset=utf-8'); Вот тогда и браузер и ваше приложение будет знать с чем имеет дело и в какой кодировке работает ваше API. Вот накидал в блокноте код php серверной части: <?php header('Content-Type: application/json; charset=utf-8'); $DBHost = "176.126.167.134"; $DBUser = "mmmmmmmmmm"; $DBPassword = "000000000000"; $DBase = "domofonkg"; $DBTable = "internetshop_users"; if (isset($_GET['id'])) { $zapros = $_GET['id']; } esle { exit('{ "status" : "нет параметра запроса"}'); } $DBLink = mysqli_connect($DBHost, $DBUser, $DBPassword, $DBase); if (!$DBLink) { return("<html><script language='JavaScript'>alert('Ошибка соединения с базой! Пожалуйста попробуйте позже.'),history.go(-1)</script></html>"); } $zapros = mysqli_real_escape_string($DBLink, $zapros); $query = "SELECT mail_index, address_of_delivery, fax, country_id, url, phone, company, icq FROM $DBTable WHERE mail_index = $zapros"; if ($DBResult = mysqli_query($DBLink, $query)) { $ResultArray = array(); $Index = 0; while($row = mysqli_fetch_array($DBResult, MYSQLI_ASSOC);) { $ResultArray[$Index] = $row; $Index++; } $ResultJSON = json_encode($ResultArray, JSON_PRETTY_PRINT | JSON_UNESCAPED_UNICODE); echo $ResultJSON; mysqli_free_result($DBResult); } mysqli_close($DBLink); И да, код выдает результат в JSON, дабы ваше приложение могло его по человечески обработать.
  2. Это можно сделать и без реверс-инжиниринга. Воспользуйтесь "Доступ к ЕГРЮЛ и ЕГРИП" https://www.nalog.ru/rn77/service/egrip2/
  3. Это не проблема компонентов, это проблема малограмотности программистов kinvey, видимо они учебник SQL еще не дочитали до места "ON DUPLICATE KEY UPDATE". Беда современных проектов - все деньги тратятся на дизайнеров и менеджеров, а на то что остается на реализацию технической части, можно нанять только индусов или малограмотных оутсорсеров по объявлению.
  4. По идее флаг нужно убирать при NotRegistered однозначно. При инвалидской регистрации тоже. Лучше пользоваться не http интерфейсом Firebase, а XMPP, там, насколько я знаю, можно получать всю инфу, вплоть до подтверждения получения пуша клиентом. В скрипте и не отправляются сообщения на не активные токены, по крайней мере у меня, зачем? В SQL запросе "WHERE active = 1" решает проблему. P.S. Надо задуматься над коммерческим PUSH сервером ;-) Площадок у меня есть, голова и руки тоже. Сделать по 50 рублей в месяц подписку. Чтоб зашел, зарегился, вбил свои данные и создавай push проекты, отправляй, получай и все такое...
  5. Можно и удалять. Но тогда не будут работать мои аналитические инструменты - частота запусков приложения, периоды активности и многое другое. У Равиля запрос добавления токена в базу вот такой: INSERT INTO PushTokens (`deviceToken`, `deviceID`, `platform`) VALUE ('$deviceToken', '$deviceID', '$platform') ON DUPLICATE KEY UPDATE `deviceToken` = '$deviceToken'"; У меня же он чуть сложнее: INSERT INTO gcm (`DeviceID`, `DeviceToken`, `City`, `last_update`, `add_date`, `RequestCount`, `Active`) VALUES ('$DeviceID','$DeviceToken','$City',NOW(),NOW(), 1, 1) ON DUPLICATE KEY UPDATE `DeviceToken` = '$DeviceToken', `City` = '$City', `last_update` = NOW(), `RequestCount` = `RequestCount` + 1, `Active` = 1 Таблица выглядит вот так CREATE TABLE `gcm` ( `id` int(11) NOT NULL AUTO_INCREMENT, `DeviceID` char(32) DEFAULT NULL, `DeviceToken` varchar(255) DEFAULT NULL, `City` varchar(100) DEFAULT NULL, `last_update` datetime DEFAULT NULL, `add_date` datetime DEFAULT NULL, `RequestCount` int(11) DEFAULT '1', `Active` bit(1) DEFAULT b'1', PRIMARY KEY (`id`), UNIQUE KEY `DeviceID_index` (`DeviceID`) USING BTREE ) ENGINE=MyISAM AUTO_INCREMENT=40337 DEFAULT CHARSET=utf8; Т.е. кроме всего прочего я вижу: Дату-время первого запуска приложения Дату-время последнего запуска приложения Количество запусков приложения Стоит ли еще приложение на этом устройстве (Active) На поле City не обращайте внимание...
  6. У девочки компьютера нет имени (в контексте сети), у него есть MAC адрес и IP адрес. Если под именами компьютеров вы имеете ввиду то что видите открывая папку Сеть на компьютере, то это как раз работа NETBIOS. Каждый компьютер под управлением Windows срёт в сеть широковещательными пакетами с криками "Это я, это я, я еще живой!". При адекватном администраторе это все отключено и заглушено, потому как в этой среде распространение вирусов максимально благоприятно. Но если вы хотите воспользоваться этим механизмом, то начните гуглить NETBIOS, или попробуйте послушать снифером порт 137 (TCP если не ошибаюсь). В теории слушая этот порт и разбирая полученные пакеты у вас будет список из связок "Имя компьютера"-"IP адрес". Имейте ввиду, что в сети более чем с двумя компьютерами на этот порт может валиться несколько сотен пакетов в секунду. И одно большое "Но" - гугль не любит микрософт, поэтому на всех не рутованных устройствах порты NETBIOS заблокированы от слова совсем, конечно же в целях безопасности.
  7. Название топика содержит ответ на ваш вопрос - TIdTCPClient, ключевое слово "TCP". Этот протокол адресует устройства (или интерфейсы) исключительно по IP адресу(IPv4 или IPv6). Компонент TIdTCPClient работает следующим образом - если TIdTCPClient.Host содержит IP адрес, все нормально, отправляем туда пакет, но если в TIdTCPClient.Host строка, то ресолвим ее в IP адрес и после этого отправляем пакет на полученный адрес. Разрешение (ресолвинг) DNS имен происходит по примерно такой цепочке : Если это localhost, то система без вопросов возвращает 127.0.0.1 Операционка смотрит свои локальные настройки (windows C:\Windows\System32\drivers\etc\hosts, unix /etc/hosts) Проверяется локальный кэш dns записей Делается запрос на DNS сервер Так же могут применяться экзотические или устаревшие методы, к примеру Windows NetBIOS Name Server (WINS server). И попробуйте перефразировать свой вопрос, уточните конкретную задачу, так будет проще понять что вам нужно.
  8. Потому что это служебное поле, за которое объект-владелец не в ответе. Для иного вы можете использовать Image2.AddObject() - в этом случае Image2 будет знать о своих "детях" (Image2.Children в количестве Image2.ChildrenCount) и при самоубийстве покарает и детей. А в случае TagObject он проигнорирует содержащийся там объект и возникнет утечка памяти. Воспринимайте TagObject как средство хранения ссылки на реально существующий в приложении объект, а не как место хранения самого объекта.
  9. В Windows ваш код работал "случайно", все дело в разных механизмах управления памятью на разных платформах и возможно в windows в какой то момент эти объекты тоже могут быть удалены. Использование TMemoryStream, в вашем случае, увеличивает накладные расходы - производится копирование участков памяти, кстати так же как и при использовании Assign (не что иное как копирование). Возможно стоит использовать обычное присвоение? Т.е. в пределах приложения хранить одну единственную копию картинки, и по мере надобности присваивать ее (Image2.Bitmap:=Image2.TagObject as TBitmap) нужным элементам. По поводу вот этого можете привести пример кода или пример приложения, где воспроизводится данная проблема?
  10. Вот кстати хорошая статья по "слабым" ссылкам в Delphi https://habrahabr.ru/post/282035/
  11. Ага, разобрался - все дело в объявлении TagObject как "слабой" ссылки: [Weak] FTagObject: TObject, т.е. присвоение этому полю не увеличивает счетчик ссылок и объект будет жив только в пределах вашей процедуры. Грубо говоря в "слабой" мы храним объект до тех пор, пока он хранится где то еще. Вам НЕОБХОДИМО создавать ГЛОБАЛЬНУЮ структуру для хранения этих объектов. К примеру сохранит картинки в TObjectList (модуль System.Generics.Collections), и после этого уже присваивать их в Image2.TagObject Вот работающий вариант вашего кода: unit copystream; 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, FMX.Objects, System.Generics.Collections; type TForm1 = class(TForm) Image1: TImage; Image2: TImage; SaveBut: TButton; LoadBut: TButton; procedure SaveButClick(Sender: TObject); procedure LoadButClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } FImageStore : TObjectList<TMemoryStream>; public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.FormCreate(Sender: TObject); begin FImageStore:=TObjectList<TMemoryStream>.Create; end; procedure TForm1.LoadButClick(Sender: TObject); begin if Assigned(Image2.TagObject) then Image2.Bitmap.LoadFromStream(Image2.TagObject as TMemoryStream); end; procedure TForm1.SaveButClick(Sender: TObject); Var LStream : TMemoryStream; begin LStream:=TMemoryStream.Create; FImageStore.Add(LStream); try Image1.Bitmap.SaveToStream(LStream); finally Image2.TagObject:=LStream; end; end; end.
  12. Действительно с TMemoryStream не работает, хотя вот так работает превосходно: procedure TForm1.LoadButClick(Sender: TObject); begin if Assigned(Image2.TagObject) then Image2.Bitmap.Assign(Image2.TagObject as TBitmap); end; procedure TForm1.SaveButClick(Sender: TObject); begin Image2.TagObject:=Image1.Bitmap; end; Насколько критично для вас использовать прокладку в виде TMemoryStream? С TMemoryStream счетчик Image2.TagObject.RefCount по какой то причине обнуляется при выходе из процедуры SaveButClick. Не понятно.
  13. Ну вот как так? Заинтриговали и закончили такой скудной развязкой. В чем была причина ошибки? Поделитесь с сообществом, а то как не дочитанная книга... ;-)
  14. Какой то странный хотфикс. Ничего не фиксит. Мой запрос https://quality.embarcadero.com/browse/RSP-17813 не пофиксили. "We also have an Android compatibility patch in the works to address Android issues around text input, control rendering and performanc" - я правильно перевел? Мы так же имеем фикс для самых насущных глюков, но вам не покажем.
  15. Подтверждаю, все заработало! Круто! ;-) Хоть и не в тему топика, но хочу какие нибудь вычисления замонстрячить!
  16. Действительно. Мог бы я и сам догадаться - функция возвращает куда больший кусок памяти чем описано структурой, вот лишние данные и залезают в память выделенную под другие нужды. Вот тут описание структуры http://docs.nvidia.com/cuda/cuda-runtime-api/structcudaDeviceProp.html#structcudaDeviceProp и видимо под каждую версию Cuda она своя. Или таскать именно cudart32_41_28.dll с приложением.
  17. Вместо утреннего кофе, уперся рогом и сделал получение информации через CUDA, тесовый проект прилагаю. В режиме отладки работает отлично, вижу размер видеопамяти, но потом вылетает с access violation (при обращении к визуальным компонентам или просто при продолжении работы). В чем дело понять не могу, сначала грешил на FMX, но проект на VCL выдает те же симптомы. Очень, очень странные дела... Код простой, используется cudaRT.pas из CUDA wraper Паскуда https://code.google.com/archive/p/pascuda/source/default/source и cudart32_65.dll идущая вместе с драйверами NVIDIA Var CudaDeviceProp : TCudaDeviceProp; hDevice: Integer; GPUMemorySize : Cardinal; LMessage : String; begin hDevice:=0; if CudaGetDeviceProperties(CudaDeviceProp, hDevice)=ceSuccess then begin GPUMemorySize:=CudaDeviceProp.TotalGlobalMem div 1024 div 1024; LMessage:=Format('GPU Memory size = %d Mb', [GPUMemorySize]); Memo.Lines.Add(LMessage); end; test099 Cuda Info VCL.7z
  18. Нет, ни в коем случае. Если стоят драйвера на видеокарту, то все будет работать. Можете попробовать запустить у себя бинарники и проверить, они выдают JSON на стандартный вывод, вот такой примерно: [ { "DeviceID": 0, "VendorID": 5208, "VendorName": "Gigabyte", "DeviceName": "GeForce GTX 960", "SMVersionString": "5.2", "SM_major": 5, "SM_minor": 2, "UUID": "GPU-f4867f81-dcc8-0f28-fbc2-b350e7927c22", "DeviceGlobalMemory": 4294967296, "pciDeviceId": 335614174, "pciSubSystemId": 918426712, "SMX": 8 } ] Нужный параметр DeviceGlobalMemory. Бинарники можно взять из архива https://github.com/nicehash/NiceHashMiner/releases/tag/1.7.5.10 , называются AMDOpenCLDeviceDetection.exe и CudaDeviceDetection.exe. Если переведете код в Delphi, буду безмерно благодарен. Сейчас в нескольких проектах (мониторинг "отваливания" карт) использую внешний вызов этих exe, что несколько неудобно.
  19. Равиль, сразу извиняюсь, готов понести наказание, но запощу решение. Как уже говорил все просто, если у вас 4345 сообщений, то делим массив токенов и отправляем 4 раза по 1000, и один раз 345. Не забывайте что вы программисты, и во всех языках программирования это делается одинаково просто. Вот код, писал прямо в гитхабе, естественно не проверял, если что то упустил, прошу прощения (а упустил я анализ результата). function pushSendOver1000($title, $text, $tokens, $server_key) { $Count_Success = 0; $DeviceCountMax = 1000; $DeviceCountIndex = 0; $DevicesTokenPacketArray = array(); while ($DeviceCountIndex<=count($tokens)) { $DevicesTokenPacketArray = array_slice($tokens, $DeviceCountIndex, $DeviceCountMax); pushSend($title, $text, $DevicesTokenPacketArray, $server_key); $DeviceCountIndex = $DeviceCountIndex + $DeviceCountMax; } } Запостил также на гитхаб. Можете ручками добавить функцию в конец https://github.com/rzaripov1990/PUSHTestFCM/blob/master/pushTest/push.php и соответственно вызывать не pushSend, а pushSendOver1000
  20. Для Cuda тут https://github.com/nicehash/NiceHashMiner/tree/master/CudaDeviceDetection , для OpenCL тут https://github.com/nicehash/NiceHashMiner/tree/master/AMDOpenCLDeviceDetection код на сях, но перевести на Delphi думаю не очень сложно.
  21. Подумайте о будущем, если проект будет развиваться и одной цифры ошибки станет не достаточно. Подумайте о наследниках-программистах (или о себе через пять лет) которые будут чесать репу и угадывать (вспоминать) что же означает каждая цифра ответа. Времена экономии каждого байта трафика прошли. Вспомните истории предшественников - 640 килобайт более чем достаточно для любого компьютера, 4294967296 ip адресов достаточно для всего человечества, размера MTU 1500 байт достаточно для TCP пакета в обозримом будущем, максимального размера файла в 4 гигабайта достаточно для любых нужд и вряд ли в будущем появятся накопители объемом более 9 терабайт (FAT32). Отдавая данные/результат в теле ответа в формате JSON вы развязываете себе руки и делаете задел на будущее. Вначале вам достаточно будет вот такого { "status" : true, "error" : 0 } потом возможно такое { "status" : false, "error" : 123, "errormessage" : "mysql deadlock in tables employments", } а потом еще что нибудь { "status" : true, "error" : 0, "errormessage" : "", "executiontime" : 304, "clastersource" : "bagama_server" } все эти добавления займут у вас одну-две строчки на php и одну-две строчки в приложении. При этом, вы сможете диагностировать ответ сервера, сидя на берегу моря, с помощью браузера вашего телефона.
  22. Не забывайте что между вашим скриптом на php и клиентом есть еще http сервер. Ваш запрос может и не дойти до модуля php, всякое бывает (обслуживание сервера, ddos атака и т.п.). В этом случае вы не сможете понять кто именно прислал вам HTTP status. Так что HTTP status codes лучше оставить в покое. Но проверять на 200 его нужно, этим вы точно определяете что ответ валидный и пришел с живого http сервера, далее уже нужно проверять содержимое ответа. Если так не хочется отдавать в ответ JSON, есть другие способы, к примеру cookie или header. Но тут тоже сложности - оперативно проверить работу сервера в браузере уже не получится, нужны специальные инструменты.
  23. Var HTTPClient : THTTPClient; HTTPResponse : IHTTPResponse; LResultStream : TStringStream; LQuery, street, house : String; LResult : Boolean; begin HTTPClient:=THTTPClient.Create; LResultStream:=TStringStream.Create; LResult:=True; street:='Ленина'; house:='1'; LQuery:='https://geocode-maps.yandex.ru/1.x/?geocode='+'Кунгур'+',+'+street+'+улица,+дом+'+house; try HTTPResponse:=HTTPClient.Get(LQuery, LResultStream); except LResult:=False; end; if LResult and (HTTPResponse.StatusCode=200) then if LResultStream.Size>0 then begin // Обрабатываем результат находящийся тут LResultStream.DataString end; LResultStream.Free; HTTPClient.Free; end;
  24. Во время добавления так же можно отключить обработчики ListView1.OnUpdatingObjects и(или) ListView1.OnUpdateObject (если у вас в них есть какой либо код). ListView1.BeginUpdate; ListView1.OnUpdatingObjects:=Nil; ListView1.OnUpdateObjects:=Nil; for i := 0 to List.Count - 1 do begin LVItems := ListView1.Items.Add; LVItems.Data['MyData']:=... ... end; ListView1.OnUpdatingObjects:=ListView1UpdateObjects; ListView1.OnUpdateObjects:=ListView1UpdatingObjects; ListView1.EndUpdate;
×
×
  • Создать...