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

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

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

  • Посещение

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

    39

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

  1. Тут в процессе работы над одним проектом понадобилось узнать IP адрес устройства. Очень не хотелось включать дополнительные разрешения приложению. Думал ограничится одним "Доступ в Интернет". Вот как это можно сделать: С помощью TIdUDPServer посылаем широковещательное сообщение, с помощью того же TIdUDPServer сами получаем его и в ABinding узнаем с какого IP оно пришло. Таким образом мы узнаем IP адрес интерфейса с маршрутом по умолчанию. Вот код, все просто: unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IdGlobal, IdSocketHandle, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer; const ConstUDPSendString = 'dfgb2hd3f6gbf'; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } FUDPServer : TIdUDPServer; FMyIP : String; procedure OnUDPServerUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); procedure GetMyIP; public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.FormCreate(Sender: TObject); begin GetMyIP; end; procedure TForm1.GetMyIP; begin FMyIP:=''; FUDPServer:=TIdUDPServer.Create; FUDPServer.DefaultPort:=46734; FUDPServer.BroadcastEnabled:=True; FUDPServer.OnUDPRead:=OnUDPServerUDPRead; FUDPServer.Active:=True; FUDPServer.Broadcast(ConstUDPSendString, FUDPServer.DefaultPort); end; procedure TForm1.OnUDPServerUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); begin AThread.Synchronize(AThread, procedure begin if BytesToString(AData).Equals(ConstUDPSendString) and FMyIP.IsEmpty then FMyIP:=ABinding.PeerIP; end ); end; end.
  2. THTTPClient асинхронность

    Var FIAsyncResult : IAsyncResult; procedure DoEndDownload(const ASyncResult: IAsyncResult); .... FHTTPClient:=THTTPClient.Create; FHTTPClient.ResponseTimeout:=FResponseTimeout; FHTTPClient.ConnectionTimeout:=FConnectionTimeout; FIAsyncResult:=FHTTPClient.BeginGet(DoEndDownload, 'https://.....'); procedure TServiceData.DoEndDownload(const ASyncResult: IAsyncResult); Var LAsyncHTTPResponse : IHTTPResponse; begin try LAsyncHTTPResponse:=THTTPClient.EndAsyncHTTP(AsyncResult); except on E:Exception do AErrorMessage:=E.Message; end; if Assigned(LAsyncHTTPResponse) then begin if LAsyncHTTPResponse.StatusCode = 200 then S:=LAsyncHTTPResponse.ContentAsString; ....
  3. Нажатие на Item в ListBox срабатывает 1 раз

    Listview против ListBox - листбокс тут не подходит, он проще, но гораздо тяжеловеснее. В некоторые папки вы зайти не сможете, при использовании Листбокса. К примеру C:\Windows\System32, у меня там 4 тысячи файлов, и даже под винду для листбокса это будет тяжело. В TFileManager использование ListView не самое оптимальное (лучше использовать DynamicApperance), но на тот момент мне нужен был работающий менеджер и за пол часа Все вопросы касаемые ListView - вне этой темы, просто изучите соответствующий раздел этого форума. Очень, очень, очень рекомендую упереться и понять как им пользоваться и как он работает. Владение ListView очень пригодится, особенно в мобильных платформах. Просто прочтите вдумчиво все темы в разделе ListView. Потраченное время окупится многократно. Процедуру SpeedButton1Click(Sender: TObject) игнорируйте, просто класс TFileManager я писал для какого то своего проекта, и этот пример, в некоторых местах, просто куски бессмысленного кода...
  4. Delphi XE8 перестали собираться проекты под Андроид. Ни с того, ни с сего. Пустой проект - тоже самое. При попытке билда вот такие ошибки. Голову сломал уже, не могу понять что произошло. [DCC Error] E2597 D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: error: cannot find -ldl D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: error: cannot find -lc D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: error: cannot find -lm D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: error: cannot find -landroid D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: error: cannot find -lEGL D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: error: cannot find -lGLESv2 D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: error: cannot find -llog D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: error: cannot find -ljnigraphics D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: error: cannot find -lGLESv1_CM D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\embarcadero\studio\16.0\lib\Android\Release\SysInit.o: in function Sysinit::__getenv(char*):SysInit(.text._ZN7Sysinit8__getenvEPc+0x4): error: undefined reference to 'getenv' [SKIP] D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\embarcadero\studio\16.0\lib\Android\Release\Androidapi.Eglext.o: in function Androidapi::Eglext::eglDestroyImageKHR(void*, void*):Androidapi.Eglext(.text._ZN10Androidapi6Eglext18eglDestroyImageKHREPvS1_+0x4): error: undefined reference to 'eglDestroyImageKHR' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\embarcadero\studio\16.0\lib\Android\Release\System.JSON.o: in function System::Json::initialization():System.JSON(.text._ZN6System4Json14initializationEv+0xc): error: undefined reference to '__aeabi_memset' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_compile.o): in function expand_workspace:pcre_compile.c(.text+0x1398): error: undefined reference to 'memcpy' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_compile.o): in function compile_regex:pcre_compile.c(.text+0x32d0): error: undefined reference to 'strncmp' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_compile.o): in function compile_regex:pcre_compile.c(.text+0x3440): error: undefined reference to 'memset' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_compile.o): in function compile_regex:pcre_compile.c(.text+0x6ec8): error: undefined reference to 'strcmp' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_compile.o): in function pcre_compile2:pcre_compile.c(.text+0x758c): error: undefined reference to 'strlen' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_compile.o): in function pcre_compile2:pcre_compile.c(.text+0x7838): error: undefined reference to 'memcmp' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x30): error: undefined reference to 'tolower' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x50): error: undefined reference to 'islower' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x64): error: undefined reference to 'toupper' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x6c): error: undefined reference to 'tolower' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0xc8): error: undefined reference to 'isupper' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0xf0): error: undefined reference to 'islower' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x118): error: undefined reference to 'isalnum' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x154): error: undefined reference to 'isspace' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x170): error: undefined reference to 'isxdigit' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x198): error: undefined reference to 'isgraph' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x1c0): error: undefined reference to 'isprint' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x1e8): error: undefined reference to 'ispunct' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x210): error: undefined reference to 'iscntrl' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x254): error: undefined reference to 'isspace' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x264): error: undefined reference to 'isalpha' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x280): error: undefined reference to 'isxdigit' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x290): error: undefined reference to 'isalnum' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/libpcre.a(pcre_maketables.o): in function pcre_maketables:pcre_maketables.c(.text+0x2b0): error: undefined reference to 'strchr' D:\Embarcadero\Studio\16.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: d:\\embarcadero\\studio\\16.0\\lib\\Android\\Release/librtlhelper.a(thunk_helpers.o): in function intercept_thunk_index(char const*):./thunk_helpers.c:46: error: undefined reference to '__assert2' [DCC Fatal Error] F2588 Linker error code: 1 ($00000001) Failed
  5. Нажатие на Item в ListBox срабатывает 1 раз

    Нет, напрямую не надо, форум - лучший способ, мало ли кому пригодится.
  6. Нажатие на Item в ListBox срабатывает 1 раз

    Держите готовый объект FileManager с демкой. Под все платформы (тестил на вин и андроиде) FileManager.zip
  7. Неадекватно отображается окно Options

    Версия Windows? Тип монитора (обычный или UHD)? Правой кнопкой на ярлыке Delphi, вкладка совместимость, поиграйте параметрами совместимости (Переопределите режим совместимости высокого разрешения).
  8. FPushService.DeviceTokenValue = nil Что делать?

    Что именно означает "не работает"? Напишите Идентификатор отправителя который указываете в демо-приложении.
  9. FPushService.DeviceTokenValue = nil Что делать?

    Вообще то я приложил к сообщению архив. Если бы удосужились его скачать и открыть, то обнаружили кроме готовой библиотеки для работы с пушами еще и демо-проект.
  10. Загрузка в потоке возможно ли ?

    Выполняйте oItem.Adapter.ResetView(oItem) в OnScrollViewChange по мере необходимости. Вначале для всех видимых + еще пару экранов вниз. При прокрутке повторяем.
  11. FPushService.DeviceTokenValue = nil Что делать?

    Да, забыл добавть, в константе ConstGCMAppID должен лежать ваш идентификатор отправителя (только циферки), к примеру 904067404541
  12. FPushService.DeviceTokenValue = nil Что делать?

    Скачал ваше тестовое приложение. Во первых в манифесте добавьте разрешение на получение <%uses-permission%> <!-- FCM push notifications permission --> <uses-permission android:name="com.google.android.c2dm.permission.RECEIVE" /> Во вторых чтобы не было каши из кода, просто используйте готовый модуль для пуш оповещений, я его публиковал уже здесь, искать лень, закину еще разок. Использование элементарное: 1. В Uses добавьте DW.PushClient и возможно понадобиться System.PushNotification (а может и нет). FPushClient : TPushClient; Код: procedure TFormMain.InitPush; begin {$IFDEF ANDROID} if FSetting.GUID.IsEmpty then Exit; if Not Assigned(FPushClient) then FPushClient := TPushClient.Create else FPushClient.Active:=False; FPushClient.GCMAppID := ConstGCMAppID; FPushClient.ServerKey := ''; FPushClient.BundleID := ''; FPushClient.UseSandbox := Debug; // Change this to False for production use! FPushClient.OnChange := PushClientChangeHandler; FPushClient.OnReceiveNotification := PushClientReceiveNotificationHandler; try FPushClient.Active:=True; except end; {$ENDIF ANDROID} end; А PushClientChangeHandler вот: procedure TFormMain.PushClientChangeHandler(Sender: TObject; AChange: TPushService.TChanges); begin if TPushService.TChange.DeviceToken in AChange then begin HDevicePushParams.DeviceID:=FPushClient.DeviceID; HDevicePushParams.DeviceToken:=FPushClient.DeviceToken; GetHTTP(MetodMinerProRegisterFCM); end; end; GetHTTP(MetodMinerProRegisterFCM); - это отправка токена на свой сервер, замените на свое. К примеру в Memo для начала. PushClient.zip
  13. FPushService.DeviceTokenValue = nil Что делать?

    Это вообще разные вещи, туда ничего пихать не нужно вообще. Но если очень хочется, то это ключь ПРИЛОЖЕНИЯ из GooglePlayConsole
  14. FPushService.DeviceTokenValue = nil Что делать?

    Из этого скрина вам нужен только Пункт 4. Пункты 2 и 3 никак не повлияют. Пункт 3 испольнять не вздумайте, не зачем ваш СЕРВЕРНЫЙ ключ светить в приложении. Это из другой оперы ключ.
  15. FPushService.DeviceTokenValue = nil Что делать?

    Что то тут вы сами себя запутали. Все просто (через жопу конечно с появлением Firebase, но ничего не поделаешь, у американцев вслед за датой-задом-наперед и имперской системой исчисления, все остальное тоже немного наперекосяк) : 1. Идете в https://console.firebase.google.com/ , нажимаете "Добавить проект", произвольное, понятное вам название проекта, страна. Нажимаем сохранить. 2. Попадаем на https://console.firebase.google.com/project/test005-e3e15/overview, красочные квадратики и разные перделки-свистелки, вверху страницы нажимаем "Добавьте Fiebase в свое приложение на Андроид". В открывшемся окне вводите Название пакета (В предыдущих сообщения вам показывали где оно), остальное не надо, нажимайте сохранить. Вам предложат скачать файл google-services.json, он вам нафик не нужен, это только для андроид студии, Эмбаркадера про это еще дочитала документацию. 3. Далее нужно найти на странице малюсенькое колесико, нажать на него, Настройки, вверху Cloud Messaging, вот на этой странице есть все что вам нужно. Скриншот прилагаю. Ключ сервера - для отправки пушей с вашего сервера. Идентификатор отправителя - для получения Токенов в вашем андроид приложении. Всякий бред в консоли разработчика (типа Подключения идентификатора отправителя ) игнорируйте, это индусские аутсорсеры пишут, с ними потеряна связь несколько лет назад из за наводнения в Индийском океане, но коммитить код они не перестали). Вот и все. P.S. Имейте ввиду, что пушсообщения могут начать приходить не сразу, у них притормаживает слегка и после добавления проекта часов 10-20 может ничего не работать. Токены начинаю выдаваться сразу.
  16. Вот простой пример накидал. Главная форма, поток, две очереди (очередь запросов и очередь ответов). Вы в главной форме вбивате два числа, и нажимаете кнопку по своему усмотрению (прибавить, умножить, разделить). Числа отправляются в Очередь запросов, поток получает задачу, выполняет и отправляет ответ в очередь ответов. Главная форма, в Application.OnIdle ждет получения результатов проверяя Очередь ответов, при получении добавляет их в Memo. Все. Проект прилагаю в архиве, вот листинг: unit UnitFormMain; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.Generics.Collections, FMX.StdCtrls, FMX.Edit, FMX.EditBox, FMX.NumberBox, FMX.Layouts, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo; type TThreadOperation = (Sum, Mult, Divinity); TThreadDataRequest = record A : Double; B : Double; Operation : TThreadOperation; end; TThreadDataAnswer = record Operation : TThreadOperation; A : Double; B : Double; X : Double; ErrorMessage : String; end; TQueueRequest = TThreadedQueue<TThreadDataRequest>; TQueueAnswer = TThreadedQueue<TThreadDataAnswer>; TExcampleThread = class(TThread) protected FQueueRequest: TQueueRequest; FQueueAnswer: TQueueAnswer; procedure Execute; override; public constructor Create(AQueueRequest : TQueueRequest; AQueueAnswer : TQueueAnswer); reintroduce; end; TFormMain = class(TForm) Memo: TMemo; Layout1: TLayout; Label1: TLabel; Label2: TLabel; ButtonSum: TButton; ButtonMult: TButton; ButtonDiv: TButton; EditA: TEdit; EditB: TEdit; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure ButtonClick(Sender: TObject); private { Private declarations } FQueueRequest: TQueueRequest; // Очередь запросов FQueueAnswer : TQueueAnswer; // Очередь ответов FExcampleThread : TExcampleThread; procedure OnApplicationIdle(Sender : TObject; var Done: Boolean); public { Public declarations } end; var FormMain: TFormMain; implementation {$R *.fmx} procedure TFormMain.FormCreate(Sender: TObject); begin FQueueRequest:=TQueueRequest.Create(10, 1000, 10); FQueueAnswer:=TQueueAnswer.Create(10, 1000, 10); Application.OnIdle:=OnApplicationIdle; FExcampleThread:=TExcampleThread.Create(FQueueRequest, FQueueAnswer); end; procedure TFormMain.FormDestroy(Sender: TObject); begin if Assigned(FExcampleThread) then begin FExcampleThread.Terminate; FExcampleThread.WaitFor; FExcampleThread.Free; end; if Assigned(FQueueRequest) then FQueueRequest.Free; if Assigned(FQueueAnswer) then FQueueAnswer.Free; end; procedure TFormMain.OnApplicationIdle(Sender : TObject; var Done: Boolean); Var AThreadDataAnswer : TThreadDataAnswer; S : String; begin if FQueueAnswer.PopItem(AThreadDataAnswer) = TWaitResult.wrSignaled then begin case AThreadDataAnswer.Operation of TThreadOperation.Sum : S:=' + '; TThreadOperation.Mult : S:=' * '; TThreadOperation.Divinity : S:=' / '; end; S:=AThreadDataAnswer.A.ToString + S + AThreadDataAnswer.B.ToString + ' = '; if Not AThreadDataAnswer.ErrorMessage.IsEmpty then S:=S + AThreadDataAnswer.ErrorMessage else S:=S + AThreadDataAnswer.X.ToString; Memo.Lines.Add(S); end; end; constructor TExcampleThread.Create(AQueueRequest : TQueueRequest; AQueueAnswer : TQueueAnswer); begin FQueueRequest:=AQueueRequest; FQueueAnswer:=AQueueAnswer; Inherited Create(False); end; procedure TExcampleThread.Execute; Var AThreadDataRequest : TThreadDataRequest; AThreadDataAnswer : TThreadDataAnswer; begin while Not Terminated do begin if FQueueRequest.PopItem(AThreadDataRequest) = TWaitResult.wrSignaled then begin AThreadDataAnswer.Operation:=AThreadDataRequest.Operation; AThreadDataAnswer.ErrorMessage:=''; AThreadDataAnswer.A:=AThreadDataRequest.A; AThreadDataAnswer.B:=AThreadDataRequest.A; AThreadDataAnswer.X:=0; try case AThreadDataRequest.Operation of TThreadOperation.Sum : AThreadDataAnswer.X:=AThreadDataRequest.A + AThreadDataRequest.B; TThreadOperation.Mult : AThreadDataAnswer.X:=AThreadDataRequest.A * AThreadDataRequest.B; TThreadOperation.Divinity : AThreadDataAnswer.X:=AThreadDataRequest.A / AThreadDataRequest.B; end; except on E : Exception do AThreadDataAnswer.ErrorMessage:=E.Message; end; FQueueAnswer.PushItem(AThreadDataAnswer); end; TThread.Sleep(10); end; end; procedure TFormMain.ButtonClick(Sender: TObject); Var AThreadDataRequest : TThreadDataRequest; begin AThreadDataRequest.A:=EditA.Text.ToDouble; AThreadDataRequest.B:=EditB.Text.ToDouble; Case TButton(Sender).Tag of 1 : AThreadDataRequest.Operation:=TThreadOperation.Sum; 2 : AThreadDataRequest.Operation:=TThreadOperation.Mult; 3 : AThreadDataRequest.Operation:=TThreadOperation.Divinity; End; FQueueRequest.PushItem(AThreadDataRequest); end; end. test116 TThreadedQueue.zip
  17. После переделки с TThread.Synchronize на TThreadedQueue приложение отработало 12 часов без проблем. Ни ошибок, ни утечек. Так что думаю проблема не в моем коде, а именно в TMonitor. Правда на тестовом приложении, с 7 потоками и синхронизацией TThread.Synchronize воспроизвести проблему не удалось, так что черт его знает на каком этапе начинает глючить.
  18. Тоже самое, один в один. Причем проект на VCL. Та же самая ошибка была в ранних версиях XE. Потом ее пофиксили. В моем случае помогло (надеюсь. пока еще тестирую) избавление от всех TThread.Synchronize в проекте. Заменил на обмен через TThreadedQueue. Теперь до строк if Assigned(SyncProc.SyncRec.FMethod) then SyncProc.SyncRec.FMethod() else if Assigned(SyncProc.SyncRec.FProcedure) then SyncProc.SyncRec.FProcedure(); вообще не доходит слава богу.
  19. JSON Pretty Print - красивый JSON

    Долго мучался отсутствием штатного средства красивого вывода JSON в текст, все что есть в комплекте, в REST к примеру, выводит убогую, не читаемую кашу. Плюнул и на написал свою функцию, на базе REST TSON.Format. function JsonPrettyPrint(AJsonValue : TJsonValue; AIndent : string = ' ') : string; var SourceContent: string; AChar: char; EOL: string; LeftIndent: string; isEOL: boolean; isInString: boolean; isInArray: boolean; isEscape: boolean; begin Result:=''; EOL:=#13#10; AIndent:= ' '; LeftIndent:=''; isEOL:=true; isInString:=false; isInArray:=false; isEscape:=false; SourceContent := AJsonValue.ToString; //This will basically display all strings as Delphi strings. Technically we should show "Json encoded" strings here. for AChar in SourceContent do begin case AChar of '{' : if not isInString and not isInArray then begin Result := Result + AChar + EOL; LeftIndent := LeftIndent + AIndent; Result := Result + LeftIndent; isEOL := true; end; ',' : if not isInString and (AChar = ',') then begin isEOL := false; if isInArray then Result := Result + AChar + ' ' else Result := Result + AChar + EOL + LeftIndent; end; '}' : if not isInString then begin Delete(LeftIndent, 1, Length(AIndent)); if not isEOL then Result := Result + EOL; Result := Result + LeftIndent + AChar; end; ':' : if not isInString and (AChar = ':') then Result := Result + AChar + ' '; else begin isEOL := false; Result := Result + AChar; end; end; isEscape := (AChar = '\') and not isEscape; if not isEscape and (AChar = '"') then isInString := not isInString; if not isEscape and (AChar = '[') then isInArray:=True; if not isEscape and (AChar = ']') then isInArray:=False; end; end; Результат налицо: { "Rig": { "Name": "node07", "Account": "3DQ9fRMVfxHaT7noy7molmuhlCI3RQkxt2y8BB", "PowerCost": [4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43, 4.43] }, "ExcavatorInstance": { "Host": "192.168.0.156", "Port": 38080, "APIToken": "asevsdrbdrtnetyjer34yb435t", "ConnectionType": "HTTP" }, "Devices": { "DeviceType": "", "UseDevices": [0, 1, 2, 3, 4] }, "Algorithms": { "cryptonight": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [32, "M=2", 876], "Speed": 1506138068.81243, "Power": 851 }, "lbry": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [95, 120, -1000], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "pascal": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "decred": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "neoscrypt": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "daggerhashimoto": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "daggerhashimoto_decred": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "daggerhashimoto_sia": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "lyra2rev2": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [95, 120, -1000], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "blake2s": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "equihash": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": ["2", "M=1", "676556"], "Speed": 1506138068.81243, "Power": 851 }, "daggerhashimoto_pascal": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "keccak": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 }, "sia": { "Enable": true, "Devices_TDP_CoreDelta_MemoryDelta": [108, 150, 500], "WorkerPerDevice": 1, "WorkerParameters": [], "Speed": 1506138068.81243, "Power": 851 } } } Конкретно в текущем случае, массивы мне нужны были в одну строку. Кому понадобиться иное - закомментируйте последние 4 строки.
  20. Полноэкранный режим редактора

    Очень странно. Все настройки аналогичны вашим. Но не работает даблклик
  21. Полноэкранный режим редактора

    Хм, у меня такой фокус не срабатывает :-( Двойной клик по заголовкам Табов с юнитами? Или я не правильно понял?
  22. Berlin HTTPClient: сломаны Cookies - ошибка в исходном коде

    Начал переносить проекты из XE8 в Berlin, столкнулся с странным затыком в простеньком коде - делаем запрос на сайт, получаем куки, делаем post авторизацию, получаем редирект, если все хорошо, то октрываем страницу из header Location. Выяснилось что не смотря на HTTPClient.AllowCookies:=True, в HTTPResponse.Cookies всегда пустота. Пришлось копать исходники. Вот что обнаружилось в source\rtl\net\System.Net.HttpClient.pas: procedure THTTPClient.ExecuteHTTPInternal(const ARequest: IHTTPRequest; const AContentStream: TStream; const AResponse: IHTTPResponse); var LRequest: THTTPRequest; LResponse: THTTPResponse; State: THTTPState; LExecResult: TExecutionResult; LClientCertificateList: TCertificateList; OrigSourceStreamPosition: Int64; OrigContentStreamPosition: Int64; OrigContentStreamSize: Int64; Status: Integer; LCookieHeader: string; begin LResponse := AResponse as THTTPResponse; LRequest := ARequest as THTTPRequest; OrigSourceStreamPosition := 0; if LRequest.FSourceStream <> nil then OrigSourceStreamPosition := LRequest.FSourceStream.Position; if AContentStream <> nil then begin OrigContentStreamPosition := AContentStream.Position; OrigContentStreamSize := AContentStream.Size; end else begin OrigContentStreamPosition := 0; OrigContentStreamSize := 0; end; State := Default(THTTPState); LClientCertificateList := TCertificateList.Create; try while True do begin LRequest.DoPrepare; // Add Cookies if FCookieManager <> nil then begin LCookieHeader := FCookieManager.CookieHeaders(LRequest.FURL); if LCookieHeader <> '' then LRequest.AddHeader('Cookie', LCookieHeader); // do not localize end; if not SetServerCredential(LRequest, LResponse, State) then Break; if not SetProxyCredential(LRequest, LResponse, State) then Break; if LRequest.FSourceStream <> nil then LRequest.FSourceStream.Position := OrigSourceStreamPosition; if LResponse <> nil then begin LResponse.FStream.Position := OrigContentStreamPosition; LResponse.FStream.Size := OrigContentStreamSize; end; LExecResult := DoExecuteRequest(LRequest, LResponse, AContentStream); case LExecResult of TExecutionResult.Success: begin if not SameText(LRequest.FMethodString, sHTTPMethodHead) then LResponse.DoReadData(LResponse.FStream); Status := LResponse.GetStatusCode; case Status of 200: begin Break; // Если запрос удачен, то выходим из цикла end; 401: begin State.Status := InternalState.ServerAuthRequired; end; 407: begin State.Status := InternalState.ProxyAuthRequired; end; else begin case Status of 301..304, 307: if FHandleRedirects and (LRequest.FMethodString <> sHTTPMethodHead) then begin Inc(State.Redirections); if State.Redirections > FMaxRedirects then raise ENetHTTPRequestException.CreateResFmt(@SNetHttpMaxRedirections, [FMaxRedirects]); end else Break; else end; State.Status := InternalState.Other; if DoProcessStatus(LRequest, LResponse) then Break; end; end; end; TExecutionResult.ServerCertificateInvalid: begin DoValidateServerCertificate(LRequest); end; TExecutionResult.ClientCertificateNeeded: begin DoNeedClientCertificate(LRequest, LClientCertificateList); end else raise ENetHTTPClientException.CreateRes(@SNetHttpClientUnknownError); end; if AllowCookies then UpdateCookiesFromResponse(LResponse); // Вот эта, критически важная процедура, при Status=200 никогда не выполняется end; // После выхода из цикла попадаем сюда if LRequest.FSourceStream <> nil then LRequest.FSourceStream.Seek(0, TSeekOrigin.soEnd); LResponse.FStream.Position := OrigContentStreamPosition; finally LClientCertificateList.Free; end; end; Т.е. разработчики исключили выполнение UpdateCookiesFromResponse(LResponse), которая помещает куки из ответа в HTTPClient. А вот код из XE8 который нормально работает с Cookies: function THTTPClient.ExecuteHTTPInternal(const ARequest: IHTTPRequest; const AContentStream: TStream): IHTTPResponse; var LRequest: THTTPRequest; LResponse: THTTPResponse; State: THTTPState; LExecResult: TExecutionResult; LClientCertificateList: TCertificateList; OrigSourceStreamPosition: Int64; OrigContentStreamPosition: Int64; OrigContentStreamSize: Int64; Status: Integer; LCookieHeader: string; begin Result := nil; LResponse := nil; LRequest := ARequest as THTTPRequest; OrigSourceStreamPosition := 0; if LRequest.FSourceStream <> nil then OrigSourceStreamPosition := LRequest.FSourceStream.Position; if AContentStream <> nil then begin OrigContentStreamPosition := AContentStream.Position; OrigContentStreamSize := AContentStream.Size; end else begin OrigContentStreamPosition := 0; OrigContentStreamSize := 0; end; State := Default(THTTPState); LClientCertificateList := TCertificateList.Create; try while True do begin LRequest.DoPrepare; // Add Cookies if FCookieManager <> nil then begin LCookieHeader := FCookieManager.CookieHeaders(LRequest.FURL); if LCookieHeader <> '' then LRequest.AddHeader('Cookie', LCookieHeader); // do not localize end; if not SetServerCredential(LRequest, LResponse, State) then Break; if not SetProxyCredential(LRequest, LResponse, State) then Break; if LRequest.FSourceStream <> nil then LRequest.FSourceStream.Position := OrigSourceStreamPosition; if LResponse <> nil then begin LResponse.FStream.Position := OrigContentStreamPosition; LResponse.FStream.Size := OrigContentStreamSize; end; LExecResult := DoExecuteRequest(LRequest, LResponse, AContentStream); case LExecResult of TExecutionResult.Success: begin if not SameText(LRequest.FMethodString, sHTTPMethodHead) then LResponse.DoReadData(LResponse.FStream); Status := LResponse.GetStatusCode; case Status of 200: begin Break; end; 401: begin State.Status := InternalState.ServerAuthRequired; end; 407: begin State.Status := InternalState.ProxyAuthRequired; end; else begin case Status of 301..304, 307: if FHandleRedirects and (LRequest.FMethodString <> sHTTPMethodHead) then begin Inc(State.Redirections); if State.Redirections > FMaxRedirects then raise ENetHTTPRequestException.CreateResFmt(@SNetHttpMaxRedirections, [FMaxRedirects]); end else Break; else end; State.Status := InternalState.Other; if DoProcessStatus(LRequest, LResponse) then Break; end; end; end; TExecutionResult.ServerCertificateInvalid: begin DoValidateServerCertificate(LRequest); end; TExecutionResult.ClientCertificateNeeded: begin DoNeedClientCertificate(LRequest, LClientCertificateList); end else raise ENetHTTPClientException.CreateRes(@SNetHttpClientUnknownError); end; end; if LRequest.FSourceStream <> nil then LRequest.FSourceStream.Seek(0, TSeekOrigin.soEnd); if AllowCookies then UpdateCookiesFromResponse(LResponse); // Здесь все верно, процедура за пределами цикла и выполняется всегда когда нужно. finally LClientCertificateList.Free; Result := IHTTPResponse(LResponse); end; end; А теперь вопрос: ну как так то? В продукте за 54 тысячи рублей сильно обидно исправлять такие косяки. Такое ощущение что разраб подрабатывал на стороне в проектах на php и забыл переключится на другой язык, там break прерывает работу аналога case и код работал бы правильно.
  23. Berlin HTTPClient: сломаны Cookies - ошибка в исходном коде

    Вот блин. А можно кусок кода при котором проблема воспроизводится? При повторном запросе к сайту или как? А то сейчас как раз буду писать кусок модуль и использованием куки для текущего проекта...
  24. fgActivityDialog

    Подумал и сделал более изящно - изменил метод Show. procedure TForm1.Button1Click(Sender: TObject); begin fgActivityDialog.Message := 'Teste'; fgActivityDialog.Show(3000); end; procedure TForm1.Button1Click(Sender: TObject); begin fgActivityDialog.Message := 'Teste'; fgActivityDialog.Cancellable:=True; fgActivityDialog.Show; end; Вот код :
  25. fgActivityDialog

    Тогда в вашем случае проще доработать сам компонент fgActivityDialog. Я добавил метод fgActivityDialog.ShowWithAutoClose(3000) : procedure TForm1.Button1Click(Sender: TObject); begin fgActivityDialog.Message := 'Teste'; fgActivityDialog.ShowWithAutoClose(3000); end; Вот измененный исходный код unit FGX.ProgressDialog : Добавлен метод procedure ShowWithAutoClose(AAutoCloseTimer : Integer); и TTimer Прошу прощение у Ярослава, за топорное вмешательство в его код :-)