Hoşgeldin, Ziyaretçi
Sitemizden yararlanabilmek için Kayıt olmalısınız.

Kullanıcı Adınız:
  

Şifreniz:
  





Forumda Ara

(Gelişmiş Arama)

Forum İstatistikleri
» Toplam Üyeler: 1.566
» Son Üye: motorola
» Toplam Konular: 3.084
» Toplam Yorumlar: 25.399

Detaylı İstatistikler

Son Aktiviteler
istenen işlem yükseltme g...
Forum: Genel Programlama
Son Yorum:

sabanakman
31 dakika önce
» Yorumlar: 2
» Okunma: 26
2-Kitap Kargo Takip - Gön...
Forum: Kitap Hakkında
Son Yorum:

Fesih ARSLAN
52 dakika önce
» Yorumlar: 33
» Okunma: 797
BMP resim dosyalarında bo...
Forum: Genel Programlama
Son Yorum:

engerex
1 saat önce
» Yorumlar: 2
» Okunma: 53
Kitap hakkında
Forum: Görüş & Öneri ve Yorum
Son Yorum:

ahmet_sinav
2 saat önce
» Yorumlar: 11
» Okunma: 390
Bileşen var mı yok mu ?
Forum: Mobil Platform - FireMonkey (FMX)
Son Yorum:

Fesih ARSLAN
2 saat önce
» Yorumlar: 1
» Okunma: 55
Özel bir TVertScrollBox
Forum: Mobil Platform - FireMonkey (FMX)
Son Yorum:

CesuR
2 saat önce
» Yorumlar: 3
» Okunma: 187
Medula Login Olma
Forum: Genel Programlama
Son Yorum:

Hayati
3 saat önce
» Yorumlar: 17
» Okunma: 470
Ağdaki Şifreli Paylaşıma ...
Forum: Genel Programlama
Son Yorum:

theSinan
5 saat önce
» Yorumlar: 15
» Okunma: 449
Soap Serverd uygulamasınd...
Forum: Genel Programlama
Son Yorum:

yhackup
6 saat önce
» Yorumlar: 4
» Okunma: 96
MSSQL Yedekleme Programı
Forum: Hazır Programlar
Son Yorum:

mrmarman
Bugün, Saat: 00:55
» Yorumlar: 6
» Okunma: 128

 
  ÇÖZÜLDÜ --- RTTI Destroy Yardım
Yazar: 3ddark - 11-02-2019, Saat: 14:35 - Forum: Genel Programlama - Yorum Yok

Bir düzen içinde olan sınıfın tüm elemanlarını ve alt elemanlarını Destroy etmek için RTTI kullanıyorum. Fakat alt elemanları bir şekilde destroy etmiş olsam dahi MemoryLeak uyarısı alıyorum.
Sorunum TFieldDB Create edilirken IsFK parametresi True verilirse.
TFieldDB elemanının altında FKCol ve FKTable sınıfları da Create ediliyor.
RTTI ile destroy yaptığımda ise aslında Debug ile altındaki sınıfları da Free ediyor. Fakat uygulamayı kapatırken MemoryLeak uyarısı alıyorum.

Önce mevcut yapanın iskeletini belirteyim. 

TTable  //TCity sınıfı
  TFieldDB  //CityName
  TFieldDB  //CountryID  Ülke sınıfına bağlantı
    TForeingKey  //Farkı tabloya bağlantı bilgileri
      FKTable //TTable Tipinden TCountry ülke sınıfı
        TFieldDB  // CountryName
        ...
        TFieldDB  //IsEUMember
      FKCol  //TFieldDB Tipinden
      ..
  TFieldDB

TTable = class; //for forward declaration

TFieldDB = class; //for forward declaration

TForeingKey = class
 private
   FFKTable: TTable;
   FFKCol: TFieldDB;
 public
   constructor Create();
   destructor Destroy; override;
   property FKTable: TTable read FFKTable write FFKTable;
   property FKCol: TFieldDB read FFKCol write FFKCol;
 end;

 TFieldDB = class
 private
   FFieldName: string;
   FFieldType: TFieldType;
   FValue: Variant;
   FSize: Integer;
   FIsPK: Boolean;
   FIsUnique: Boolean;
   FIsNullable: Boolean;
   FIsFK: Boolean;
   FFK: TForeingKey;
 public
   destructor Destroy; override;
   property FieldName: string read FFieldName write FFieldName;
   property FieldType: TFieldType read FFieldType write FFieldType;
   property Value: Variant read FValue write FValue;
   property Size: Integer read FSize write FSize default 0;
   property IsPK: Boolean read FIsPK write FIsPK default False;
   property IsUnique: Boolean read FIsUnique write FIsUnique default False;
   property IsNullable: Boolean read FIsNullable write FIsNullable default True;
   property IsFK: Boolean read FIsFK write FIsFK default False;
   property FK: TForeingKey read FFK write FFK;

   constructor Create(const pFieldName: string; const pFieldType: TFieldType;
     const pValue: Variant; const pMaxLength: Integer=0; const pIsFK: Boolean=False; const pIsNullable: Boolean=True);

   procedure Clone(var pField: TFieldDB);
   procedure SetControlProperty(const pTableName: string; pControl: TWinControl);
 end;
 
Aşağıdaki gibi bir tablo sınıfım var. Ben bu tablo sınıfının içindeki tüm FCityName gibi private alanların hepsini destroy etmek istiyorum.

type
 TSysCity = class(TTable)
 private
   FCityName: TFieldDB;
   FCarPlateCode: TFieldDB;
   FCountryID: TFieldDB;
 protected
 published
   ...
 public
    ...
   property CityName: TFieldDB read FCityName write FCityName;
   property CountryID: TFieldDB read FCountryID write FCountryID;
   property CarPlateCode: TFieldDB read FCarPlateCode write FCarPlateCode;
 end;

implementation

constructor TSysCity.Create(OwnerDatabase:TDatabase);
begin
  inherited Create(OwnerDatabase);
  TableName := 'sys_city';
  SourceCode := '1000';

  FCityName := TFieldDB.Create('city_name', ftString, '', 0, False, False);
  FCountryID := TFieldDB.Create('country_id', ftInteger, 0, 0, True, False);  //burada olduğu gibi Create edip alt satırdaki gibi FK bağlantılı create edildiğinde sorun oluyor. 
  FCountryID.FK.FKTable := TSysCountry.Create(Database);  //Bu satırı ve altındaki satırı eklemeden üst satırdaki 0,0 dan sonraki True parametreyi false olarak alırsam sorunsuz çalışıyor.
  FCountryID.FK.FKCol := TFieldDB.Create(TSysCountry(FCountryID.FK.FKTable).CountryName.FieldName, TSysCountry(FCountryID.FK.FKTable).CountryName.FieldType, '', 0, False, False);
  FCarPlateCode := TFieldDB.Create('car_plate_code', ftInteger, 0, 0, False, True);
end;
destructor TTable.Destroy;
var
 vCtx : TRttiContext;
 vRtm : TRttiMethod;
 vRtf : TRttiField;
 vRtt : TRttiType;
 AValue: TValue;
 AObject: TObject;
 AField: TFieldDB;
begin
 vCtx := TRttiContext.Create;
 vRtt := vCtx.GetType(Self.ClassType);
 if Assigned(vRtt) then
   for vRtf in vRtt.GetFields do
     if Assigned(vRtf) then
       if vRtf.FieldType is TRttiInstanceType then
         //TFieldDB olup olmadığını burada kontrol edebileceğimiz gibi aşağıda da kontrol edebilirdik.
         if TRttiInstanceType(vRtf.FieldType).MetaclassType.InheritsFrom(TFieldDB) then
         begin
           AValue := vRtf.GetValue(Self);
           AObject := nil;
           if not AValue.IsEmpty then
             AObject := AValue.AsObject;

           if Assigned(AObject) then
             if AObject.InheritsFrom(TFieldDB) then  //TFieldDB olup olmadığını burada da kontrol edebiliriz.
               for vRtm in vRtf.FieldType.GetMethods('Destroy') do
               begin
                 if vRtm.IsDestructor then
                 begin
                   vRtm.Invoke(vRtf.GetValue(Self), []);
                   vRtf.SetValue(Self, nil);
                   break;
                 end;
               end;
         end
Ayrıca diğer Destroy kodlarıda burada.
destructor TFieldDB.Destroy;
begin
 if Assigned(FFK) then
   FFK.Free;
 inherited;
end;

destructor TForeingKey.Destroy;
begin
 if Assigned(FFKCol) then
   FFKCol.Free;
 if Assigned(FFKTable) then
   FFKTable.Free;
 inherited;
end;
Yanlış birşey yapmıyorsam normal şartlarda TFieldDB destroy olduğu anda TForeingKey sınıf tanımlı ise onuda destroy ediyor. Alt alta zincirleme şeklinde tüm elemanların silinmesi gerekiyor. Gerçi siliniyor görünüyor da. Fakat MemoryLeak oluşuyor. Sadece FK tanımlası yaptığım zaman.

MemoryLeak farklı bir durumdan kaynaklanıyormuş. 2 gündür gözden kaçırdığım farklı bir noktaya baktığım için bulamadığım bir sorundu. Şimdi buldum benim dalgınlığımdan kaynaklanan bir durum.

Örnek olması adına burada bu kod bulunsun belki başkalarının işine yarayabilir.

Bu konuyu yazdır

  [Çözüldü] Fmx grid veya stringgrid hücre renklendirme
Yazar: CesuR - 11-02-2019, Saat: 10:04 - Forum: Mobil Platform - FireMonkey (FMX) - Yorumlar (4)

Konuyu kapatmıştım ama son gördüğüm örnek dikkatimi çekti. Aşağıdaki örnekte Fmx te stringgridin içindeki bilgiye göre hücre rengi değiştiriliyor. Fakat sorun tek bir hücre değil bütün kolon veya satırın rengi değişiyor. Sadece tek bir hücrenin rengini nasıl değiştiririm.

procedure TForm1.StringGrid1DrawColumnCell(Sender: TObject;
 const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
 const Row: Integer; const Value: TValue; const State: TGridDrawStates);
var
 aRowColor: TBrush;
 aNewRectF: TRectF;
begin
 aRowColor := TBrush.Create(TBrushKind.Solid, TAlphaColors.Alpha);

 if (StringGrid1.Cells[1, Row] = '1') then
   aRowColor.Color := TAlphaColors.Green
 else
   aRowColor.Color := TAlphaColors.Red;

 aNewRectF := Bounds;
// aNewRectF.Inflate(3, 3);
 Canvas.FillRect(aNewRectF, 0, 0, [], 1, aRowColor);
 Column.DefaultDrawCell(Canvas, Bounds, Row, Value, State);

 aRowColor.free;
end;

Bu konuyu yazdır

  Instagram Video Link Alma
Yazar: Halil Han Badem - 10-02-2019, Saat: 10:32 - Forum: Geliştirici Araçları - Yorumlar (3)

Selamlar,

Sitemde bulunan ve benim geçmişte yazdığım bir özelliği sizlere de sunmak istedim. Post ettiğiniz Instagram videosunun linkini size geri dönderir. Profilin herkese açık olması gerekiyor tabi ki. PHP kodlarını ben Delphi'ye çevirdim. Hatta android'de bir uygulama bile tasarladım yakın çevreme sundum. Delphi kodlarını PHP çevirerek siteme yükledim. İşine yarayacak olur belki;

Kullanım: https://halilhanbadem.com/instagramvideo...i9d_PHKWx/

"videourl" parametresi ile video linklerini post edip sonuç dönderebilirsiniz. Bu dosyanın en güzel özelliği herhangi bir servise bağlı olmaması. Yani başka bir site ile bağlantı kurmuyor tüm işlemleri kendi yapıyor. Bir yere bağlı değil. Delphi uygulamasını da müsait bir anımda Github üzerinden paylaşmayı düşünüyorum.

Saygılarımla,
İyi çalışmalar.

Bu konuyu yazdır

  SQL Tablo Var veya Yok Kontrolu !!
Yazar: OZCANK - 10-02-2019, Saat: 09:14 - Forum: Genel Programlama - Yorumlar (8)

Arkadaşlar Merhaba , Ben bir yerde takıldım bana yardımcı olur musunuz ?
DATA değişkeninde ilgili şirketi buluyorum ve bu şirket altında 'TBLPARAMETRE' tablosu varsa programa girecek yoksa tabloyu create edecek bunu nasıl yapabilirim?
Şirket Databases 'SOFT2019'
Şirket altındaki Tablo 'TBLPARAMETRE'

Bu şekilde oluşturuyor fakat ben 'USE [SOFT2019]' şirket adını yazarsam  

Var
DATA:String;
begin
//////////////şirket datasını bulma
    DATA:=DBLookupComboBox1.Text;
    ADOConnection1.Connected:=False;
    memo1.Lines.LoadFromFile('c:\Pro\dataconnection.txt');
    ADOConnection1.DefaultDatabase:=DATA;
    ADOConnection1.Connected:=True;
/////////////////////////////////////
SIRKET.Close;
SIRKET.SQL.Clear;
SIRKET.SQL.Add('USE [SOFT2019]');
SIRKET.SQL.Add('SET ANSI_NULLS ON');
SIRKET.SQL.Add('SET QUOTED_IDENTIFIER ON');
SIRKET.SQL.Add('SET ANSI_PADDING ON');
SIRKET.SQL.Add('CREATE TABLE [dbo].[TBLPARAMETRE](');
SIRKET.SQL.Add('[PARAM_1] [varchar](15) NULL,');

Bu konuyu yazdır

  Trend VCL Hk.
Yazar: wiseman - 10-02-2019, Saat: 08:56 - Forum: Merakımdan Soruyorum - Yorum Yok

Sevgili meslektaşlarım,

Delphi içerisinde bulunan starndar Teechart kütüphanesinde kullanılan DBChart bileşenlerini kullanıyorum. Lakin gerek zoom işlemi, gerekse görselliği açsından, tam olarak istediğim işlemi yapmıyor. Çünkü, trend içindeki değerleri zoom lama yaparken yaklaştırmayı iyi yaparken, uzaklaşırken tekrar ilk haline dönüyor. Yani kademe kademe büyütüyor ama kademe kademe küçültmeden tek bir işlemde en başa dönüyor. Elinde örnek VCL olan arkadaşlar varsa, paylaşırlarsa çok sevinirim.

Xe2 versiyonu için kullanabileceğim, önerebileceğiniz ya da sizlerin kullanmış olduğu daha kapsamlı bir DBChart bileşeni bilgisi rica ediyorum.
İyi çalışmalar dilerim.

Bu konuyu yazdır

  Bu kodu çevirirken nerede hata yapıyorum ?
Yazar: seci20 - 09-02-2019, Saat: 19:19 - Forum: Genel Programlama - Yorumlar (13)

Ustalarım merhaba. Adb protocokolünü kullanarak android cihazlara bağlanmak istiyorum. Yalnız bunu adb.exe kullanamadan yapmak istiyorum. C++ ve python kodu olarak internette var delphiye çeviriyorum ama bir türlü hata vermemesini sağlayamadım.

C++ kodu şu şekilde.


AdbOperator.h

Kod:
#if !defined(AFX_ADBOPERATOR_H__5DEB1F22_4BE7_4C25_9541_D4F238676DDC__INCLUDED_)
#define AFX_ADBOPERATOR_H__5DEB1F22_4BE7_4C25_9541_D4F238676DDC__INCLUDED_

#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000
// AdbOperator.h : header file
//

typedef void* ADBAPIHANDLE;

typedef struct _AdbInterfaceInfo {
    /// Inteface's class id (see SP_DEVICE_INTERFACE_DATA for details)
    GUID          class_id;
    
    /// Interface flags (see SP_DEVICE_INTERFACE_DATA for details)
    unsigned long flags;
    
    /// Device name for the interface (see SP_DEVICE_INTERFACE_DETAIL_DATA
    /// for details)
    wchar_t       device_name[1];
} AdbInterfaceInfo;

typedef enum _AdbOpenAccessType {
    /// Opens for read and write access.
    AdbOpenAccessTypeReadWrite,
        
        /// Opens for read only access.
        AdbOpenAccessTypeRead,
        
        /// Opens for write only access.
        AdbOpenAccessTypeWrite,
        
        /// Opens for querying information.
        AdbOpenAccessTypeQueryInfo,
} AdbOpenAccessType;


typedef enum _AdbOpenSharingMode {
    /// Shares read and write.
    AdbOpenSharingModeReadWrite,
        
        /// Shares only read.
        AdbOpenSharingModeRead,
        
        /// Shares only write.
        AdbOpenSharingModeWrite,
        
        /// Opens exclusive.
        AdbOpenSharingModeExclusive,
} AdbOpenSharingMode;

typedef bool (__cdecl *AdbCloseHandle)(ADBAPIHANDLE);
typedef ADBAPIHANDLE (__cdecl *AdbEnumInterfaces)(GUID,bool,bool,bool);
typedef bool (__cdecl *AdbNextInterface)(ADBAPIHANDLE,AdbInterfaceInfo*,unsigned long*);
typedef ADBAPIHANDLE (__cdecl *AdbCreateInterface)(GUID,unsigned short,unsigned short,unsigned char);
typedef ADBAPIHANDLE (__cdecl *AdbOpenDefaultBulkReadEndpoint)(ADBAPIHANDLE,AdbOpenAccessType,AdbOpenSharingMode);

/////////////////////////////////////////////////////////////////////////////
// AdbOperator window

class AdbOperator
{
// Construction
public:
    AdbOperator();

// Attributes
public:

// Operations
public:
    HMODULE m_hAdbwinapi;
    AdbCloseHandle m_pAdbCloseHandle;
    AdbEnumInterfaces m_pAdbEnumInterfaces;
    AdbNextInterface m_pAdbNextInterface;
    AdbCreateInterface m_pAdbCreateInterface;
    AdbOpenDefaultBulkReadEndpoint m_pAdbOpenDefaultBulkReadEndpoint;

    BOOL InitAdbApi();
    VOID DeInitAdbApi();
    int  ScanAdbDevice();
   BOOL IsAdbDeviceOnline();
   int ExecPackCmd(long nUserdataSize);
   BOOL PullImage(CString strTargetImagePath);
    virtual ~AdbOperator();
   
    // Generated message map functions
protected:
private:
   CString m_strModulePath;
    CString m_strAdbDllePath;
   int Exec(char** bufRawOutput, const CString adbCmd, int nTimeoutCount);
};

/////////////////////////////////////////////////////////////////////////////

//{{AFX_INSERT_LOCATION}}
// Microsoft Visual C++ will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_ADBOPERATOR_H__5DEB1F22_4BE7_4C25_9541_D4F238676DDC__INCLUDED_)


AdbOperator.cpp

Kod:
// AdbOperator.cpp : implementation file
//

#include "stdafx.h"
#include "FirmwareModifier.h"
#include "AdbOperator.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

extern cmLog *g_pPluginLogObject;
#define ANDROID_USB_CLASS_ID \
{0xf72fe0d4, 0xcbcb, 0x407d, {0x88, 0x14, 0x9e, 0xd6, 0x73, 0xd0, 0xdd, 0x6b}};
static const GUID usb_class_id = ANDROID_USB_CLASS_ID;

/////////////////////////////////////////////////////////////////////////////
// AdbOperator

AdbOperator::AdbOperator()
{
   // Init module path
   GetModuleFileName(NULL, m_strModulePath.GetBuffer(MAX_PATH), MAX_PATH);
   m_strModulePath.ReleaseBuffer();
   m_strModulePath = m_strModulePath.Left(m_strModulePath.ReverseFind(_T('\\'))+1);
    m_strAdbDllePath = m_strModulePath.Left(m_strModulePath.ReverseFind(_T('\\'))+1)+_T("bin\\");
}

AdbOperator::~AdbOperator()
{
}

BOOL AdbOperator::InitAdbApi()
{
    g_pPluginLogObject->Record(_T("%s"),m_strAdbDllePath+ _T("AdbWinApi.dll"));
    if (!PathFileExists(m_strAdbDllePath + _T("AdbWinApi.dll")))
    {
        CString strSysDir=_T("");
        GetWindowsDirectory(strSysDir.GetBuffer(MAX_PATH),MAX_PATH);
        strSysDir.ReleaseBuffer();
        if (strSysDir.IsEmpty())
        {
            strSysDir = _T("c:\\windows\\system32\\");
        }
        else
        {
            strSysDir += _T("\\system32\\");
        }
        if (!PathFileExists(strSysDir + _T("AdbWinApi.dll")))
        {
            if (g_pPluginLogObject)
            {
                g_pPluginLogObject->Record(_T("ERROR:InitAdbApi-->PathFileExists failed"));
            }
            return FALSE;
        }
        m_hAdbwinapi = LoadLibrary(strSysDir + _T("AdbWinApi.dll"));
    }
    else
        m_hAdbwinapi = LoadLibrary(m_strAdbDllePath + _T("AdbWinApi.dll"));

    if (!m_hAdbwinapi)
    {
        if (g_pPluginLogObject)
        {
            g_pPluginLogObject->Record(_T("ERROR:InitAdbApi-->LoadLibrary failed"));
        }
        return FALSE;
    }
    m_pAdbCloseHandle = (AdbCloseHandle)GetProcAddress( m_hAdbwinapi, "AdbCloseHandle");
    if (m_pAdbCloseHandle==NULL)
    {
        if (g_pPluginLogObject)
        {
            g_pPluginLogObject->Record(_T("ERROR:InitAdbApi-->Get AdbCloseHandle failed"));
        }
        return FALSE;
    }

    m_pAdbEnumInterfaces = (AdbEnumInterfaces)GetProcAddress( m_hAdbwinapi, "AdbEnumInterfaces");
    if (m_pAdbEnumInterfaces==NULL)
    {
        if (g_pPluginLogObject)
        {
            g_pPluginLogObject->Record(_T("ERROR:InitAdbApi-->Get AdbEnumInterfaces failed"));
        }
        return FALSE;
    }

    m_pAdbNextInterface = (AdbNextInterface)GetProcAddress( m_hAdbwinapi, "AdbNextInterface");
    if (m_pAdbNextInterface==NULL)
    {
        if (g_pPluginLogObject)
        {
            g_pPluginLogObject->Record(_T("ERROR:InitAdbApi-->Get AdbNextInterface failed"));
        }
        return FALSE;
    }

    m_pAdbCreateInterface = (AdbCreateInterface)GetProcAddress( m_hAdbwinapi, "AdbCreateInterface");
    if (m_pAdbCreateInterface==NULL)
    {
        if (g_pPluginLogObject)
        {
            g_pPluginLogObject->Record(_T("ERROR:InitAdbApi-->Get AdbCreateInterface failed"));
        }
        return FALSE;
    }

    m_pAdbOpenDefaultBulkReadEndpoint = (AdbOpenDefaultBulkReadEndpoint)GetProcAddress( m_hAdbwinapi, "AdbOpenDefaultBulkReadEndpoint");
    if (m_pAdbOpenDefaultBulkReadEndpoint==NULL)
    {
        if (g_pPluginLogObject)
        {
            g_pPluginLogObject->Record(_T("ERROR:InitAdbApi-->Get AdbOpenDefaultBulkReadEndpoint failed"));
        }
        return FALSE;
    }
/*
    ADBAPIHANDLE adbHandle=NULL,pipeHandle=NULL;
    adbHandle = m_pAdbCreateInterface(usb_class_id,0x0bb4,0x0c02,0x1);
    if (adbHandle)
    {
        //      HANDLE hDevice = INVALID_HANDLE_VALUE;
        //       CString strDevPipe=_T("\\\\?\\usb#vid_0bb4&pid_0c02&mi_01#6&21ed2e15&0&0001#{f72fe0d4-cbcb-407d-8814-9ed673d0dd6b}\\BullkWrite");
        //       hDevice = CreateFile(strDevPipe,
        //      GENERIC_WRITE,
        //       FILE_SHARE_WRITE,
        //      NULL,
        //       OPEN_EXISTING,
        //       FILE_FLAG_OVERLAPPED,
        //       NULL);
        //      int iErr;
        //      iErr = GetLastError();
        pipeHandle = m_pAdbOpenDefaultBulkReadEndpoint(adbHandle,AdbOpenAccessTypeReadWrite,AdbOpenSharingModeReadWrite);
        m_pAdbCloseHandle(adbHandle);
    }
    else
    {
        int iErr;
        iErr = GetLastError();
    }
*/
    return TRUE;

}


VOID AdbOperator::DeInitAdbApi()
{
    if (m_hAdbwinapi)
    {
        FreeLibrary(m_hAdbwinapi);
        m_hAdbwinapi = NULL;
    }
    if (m_pAdbCloseHandle)
    {
        m_pAdbCloseHandle = NULL;
    }
    if (m_pAdbEnumInterfaces)
    {
        m_pAdbEnumInterfaces = NULL;
    }
    if (m_pAdbNextInterface)
    {
        m_pAdbNextInterface = NULL;
    }
}


int  AdbOperator::ScanAdbDevice()
{
    char entry_buffer[2048];
    char interf_name[2048];
    AdbInterfaceInfo* next_interface = (AdbInterfaceInfo*)(&entry_buffer[0]);
    unsigned long entry_buffer_size = sizeof(entry_buffer);
    char* copy_name;
    int nDeviceCount=0;
    // Enumerate all present and active interfaces.
    ADBAPIHANDLE enum_handle = m_pAdbEnumInterfaces(usb_class_id, true, true, true);

    if (NULL == enum_handle)
    {
        if (g_pPluginLogObject)
        {
            g_pPluginLogObject->Record(_T("ERROR:ScanAdbDevice-->AdbEnumInterfaces failed,ErrCode(%d)"),GetLastError());
        }
        return nDeviceCount;
    }

    while (m_pAdbNextInterface(enum_handle, next_interface, &entry_buffer_size))
    {
        // TODO: FIXME - temp hack converting wchar_t into char.
        // It would be better to change AdbNextInterface so it will return
        // interface name as single char string.
        const wchar_t* wchar_name = next_interface->device_name;
        for(copy_name = interf_name;L'\0' != *wchar_name;wchar_name++, copy_name++)
        {
            *copy_name = (char)(*wchar_name);
        }
        *copy_name = '\0';

        nDeviceCount++;

        entry_buffer_size = sizeof(entry_buffer);
    }
    m_pAdbCloseHandle(enum_handle);
    return nDeviceCount;
}

int AdbOperator::Exec( char** bufRawOutput, const CString adbCmd, int nTimeoutCount )
{
   char cmd[MAX_PATH+256];
   CString strCmd = m_strModulePath + _T("bin\\adb.exe ") + adbCmd;
   em::EmCharSet::Tcs2Mbs(cmd, (LPTSTR)(LPCTSTR)strCmd);
    g_pPluginLogObject->Record(strCmd);
   return em::EmProcess::SendCommand(bufRawOutput, cmd, nTimeoutCount);
}

BOOL AdbOperator::IsAdbDeviceOnline()
{
   char *online = "device";
   char *retBuf = NULL;
   LPTSTR lpStr = NULL;
   int nSize = 0;
   int nRet = 0;
 
   nRet = Exec(&retBuf, _T("devices"), 5);
   if (nRet > 0) {
       char *ptr;
       ptr = strstr(retBuf, online);
       if (ptr) {
           if (retBuf)
           {
               delete retBuf;
               retBuf = NULL;
           }
           return TRUE;
       }
   }

   if (retBuf)
   {
       AnsiToUnicode(lpStr,nSize,retBuf);
       g_pPluginLogObject->Record(_T("IsAdbDeviceOnline faild, return:%d, reson:%s"), nRet, lpStr);
       delete retBuf;
        delete lpStr;
       retBuf = NULL;
   }
   else
   {
       g_pPluginLogObject->Record(_T("IsAdbDeviceOnline faild, return:%d"), nRet);
   }

   return FALSE;
}

int AdbOperator::ExecPackCmd(long nUserdataSize)
{
   char *ok = "PACK_OK";
   char *error = "PACK_ERROR";
   char *retBuf = NULL;
   LPTSTR lpStr = NULL;
   int nSize = 0;
   int nRet = 0;
    int i=0;

    g_pPluginLogObject->Record(_T("ExecPackCmd nUserdataSize:%ld"), nUserdataSize);
   CString cmd;

   cmd.Format(_T("shell /system/bin/packdata.sh %u"), nUserdataSize);
    nRet = Exec(&retBuf, cmd, 60*5);
    
   if (nRet > 0) {
       char *ptr;
       ptr = strstr(retBuf, ok);
       if (ptr) {
           if (retBuf) {
               delete retBuf;
               retBuf = NULL;
           }
           return 0;
       } else {
           LPWSTR wstrRetBuf;
           int nSize;
           if (AnsiToUnicode(wstrRetBuf,nSize,retBuf)) {
               g_pPluginLogObject->Record(wstrRetBuf);
               delete wstrRetBuf;
               wstrRetBuf = NULL;
           }
           if (retBuf) {
               delete retBuf;
               retBuf = NULL;
           }
           return -1;
       }
       if (retBuf) {
           delete retBuf;
           retBuf = NULL;
       }
       return TRUE;
   }

   if (retBuf)
   {
       AnsiToUnicode(lpStr,nSize,retBuf);
       g_pPluginLogObject->Record(_T("ExecPackCmd faild, return:%d, reson:%s"), nRet, lpStr);
       delete retBuf;
        delete lpStr;
       retBuf = NULL;
   }
   else
   {
       g_pPluginLogObject->Record(_T("ExecPackCmd faild, return:%d"), nRet);
   }
   return -2;
}

BOOL AdbOperator::PullImage(CString strTargetImagePath)
{
   char *tag = "KB/s";
   char *retBuf = NULL;
   LPTSTR lpStr = NULL;
   int nSize = 0;
   int nRet = 0;

   CString cmd = _T("pull /mnt/sdcard/databk.img ");
   cmd += strTargetImagePath;
   nRet = Exec(&retBuf, cmd, 600);
    //g_pPluginLogObject->Record(_T("PullImage %s\n"),retBuf);
   if (nRet > 0) {
       char *ptr;
       ptr = strstr(retBuf, tag);
       if (ptr) {
           if (retBuf) {
               delete retBuf;
               retBuf = NULL;
           }
           return TRUE;
       }
   }
   if (retBuf)
   {
       AnsiToUnicode(lpStr,nSize,retBuf);
       g_pPluginLogObject->Record(_T("PullImage faild, return:%d, reson:%s"), nRet, lpStr);
       delete retBuf;
        delete lpStr;
       retBuf = NULL;
   }
   else
   {
       g_pPluginLogObject->Record(_T("PullImage faild, return:%d"), nRet);
   }
   return FALSE;
}

/////////////////////////////////////////////////////////////////////////////
// AdbOperator message handlers



Python kodu şu şekilde 

Kod:
import ctypes


class GUID(ctypes.Structure):
  _fields_ = [("Data1", ctypes.c_ulong),
              ("Data2", ctypes.c_ushort),
              ("Data3", ctypes.c_ushort),
              ("Data4", ctypes.c_ubyte*8)]


class AdbInterfaceInfo(ctypes.Structure):
  _fields_ = [("class_id", GUID),
              ("flags", ctypes.c_ulong),
              ("device_name", ctypes.c_wchar*800)]

def strGUID(GUID):
  string = ''
  string = string + '%x' % buff.class_id.Data1 + '-%x' % buff.class_id.Data2 + '-%x' % buff.class_id.Data3
  string = string + '-%x' % buff.class_id.Data4[0]
  string = string + '%x' % buff.class_id.Data4[1]
  string = string + '%x' % buff.class_id.Data4[2]
  string = string + '%x' % buff.class_id.Data4[3]
  string = string + '%x' % buff.class_id.Data4[4]
  string = string + '%x' % buff.class_id.Data4[5]
  string = string + '%x' % buff.class_id.Data4[6]
  string = string + '%x' % buff.class_id.Data4[7]
  return string

dll = ctypes.cdll.LoadLibrary('AdbWinApi.dll')
usb_class_id = GUID(0xF72FE0D4, 0xCBCB, 0x407d, (0x88, 0x14, 0x9e, 0xd6, 0x73, 0xd0, 0xdd, 0x6b))
enum_handle = dll.AdbEnumInterfaces(usb_class_id, ctypes.c_bool('true'), ctypes.c_bool('true'), ctypes.c_bool('true'))

while(1):
  buff = AdbInterfaceInfo()
  size = ctypes.c_ulong(ctypes.sizeof(buff))
  status = dll.AdbNextInterface(enum_handle, ctypes.byref(buff), ctypes.byref(size))

  if status==1:
      #print "GUID = " + strGUID(buff.class_id)
      #print "status = " + str(status)
      #print "Name = " + str(buff.device_name)
      hAdbApi = dll.AdbCreateInterfaceByName(buff.device_name);
      if hAdbApi == 0:
          print 'AdbCreateInterfaceByName Fail'
      else:
          serial = ' '*128
          pserial = ctypes.c_char_p()
          pserial.value = serial
          serial_len = ctypes.c_ulong(len(serial))
          ret = dll.AdbGetSerialNumber(hAdbApi, pserial, ctypes.byref(serial_len), ctypes.c_bool('false'));
          if ret == 1:
              print 'Device Name: ' + '%s'% serial
          else:
              print 'Get Device Name Fail'
  else:
      print 'Finished'
      break



Benim kodumda şu şekilde.

unit Unit1;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
 TForm1 = class(TForm)
   mmo1: TMemo;
   btn1: TButton;
   procedure btn1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);

 private
   { Private declarations }
 public
   { Public declarations }
 end;
type

 ADBAPIHANDLE = Pointer;
type
AdbInterfaceInfo = packed record
   class_id: TGUID;
   flags : LongWord;
   device_name: Pwidechar;
 end;

var
 Form1: TForm1;
 AdbLoad: THandle;
 enum_handle: ADBAPIHANDLE;

 AdbEnumInterfaces:  function(class_id: TGUID; exclude_not_present: Boolean;
                                                exclude_removed:     Boolean;
                                                active_only:         Boolean): ADBAPIHANDLE; cdecl;

 AdbNextInterface:  function(adb_handle:ADBAPIHANDLE;Info : AdbInterfaceInfo;Size : LongWord): Bool; cdecl;
implementation

{$R *.dfm}


Procedure LoadMyLibrary(FileName: String);
begin
   AdbLoad := LoadLibrary(PWideChar(FileName));
     if AdbLoad = 0 then begin
         MessageBox(0,'Hata',0,0);
         exit;
     end;
   AdbEnumInterfaces := GetProcAddress(Adbload, 'AdbEnumInterfaces');
   AdbNextInterface  := GetProcAddress(AdbLoad, 'AdbNextInterface');
   //AdbCloseHandle    := GetProcAddress(AdbLoad, 'AdbCloseHandle');
     if @AdbEnumInterfaces = nil then
     begin
        MessageBox(0,'Hata',0,0);
        exit;
     end;

          if @AdbNextInterface = nil then
          begin
        MessageBox(0,'Hata',0,0);
        exit;
     end;



end;




procedure TForm1.btn1Click(Sender: TObject);

const
   ANDROID_USB_CLASS_ID: TGUID = '{F72FE0D4-CBCB-407d-8814-9ED673D0DD6B}';
   var
   Checkinfo : AdbInterfaceInfo;
   Size : LongWord;
begin
enum_handle := AdbEnumInterfaces(ANDROID_USB_CLASS_ID, True, True, True);





 if AdbNextInterface(enum_handle,Checkinfo,Size) then
  ShowMessage('başarılı')
  else
  ShowMessage('hata');




end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 LoadMyLibrary('AdbWinApi.dll');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeLibrary(Adbload);
end;

end.


AdbInterfaceInfo bulunan device_name pwide char yerine array char olarak kullandım gene hata ile karşılaşıyorum.Altta kullandığım dll dosyaları var. Yardımcı olabilirmisiniz nerede hata yapıyorum ? 

Kullandığım dll dosyaları

Bu konuyu yazdır

  çözüldü-pardusda mysql ve firebird servisleri devrede mi?
Yazar: sadikacar60 - 09-02-2019, Saat: 17:59 - Forum: Delphi Linux - Yorumlar (3)

arkadaşlar pardusda depodan firebird ve mysql ile ilğili tüm dosyaları yükledim. kuruldu.
hizmetlerden baktığımda ikiside devrede görünüyor 
ayrıca terminalden hangi komutları kullanarak devrede olup olmadığını 
kontrol ederiz.

saygılarımla

Bu konuyu yazdır

  Medula Login Olma
Yazar: Hayati - 09-02-2019, Saat: 12:06 - Forum: Genel Programlama - Yorumlar (17)

@SimaWB hocamızın makaleleri ile https://optik.sgk.gov.tr/Optik_Firma_Web/login.jsp adresine login olmaya çalışıyorum, makaleleri bozmama adına yeni konu açtım.

Kendi örneği üzerinde, şu iki fonksiyon ile captcha indirip form da gösteriyorum

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
   try
      Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
   except
      Result := False;
   end;
end;

procedure chaptaIndir;
var
  sourceFile,DestFile : string;
begin
  SourceFile := 'https://optik.sgk.gov.tr/Optik_Firma_Web/CaptchaServlet';
  DestFile := ExtractFilePath(Application.ExeName) + '\captcha.png';
  DownloadFile(SourceFile, DestFile);
end;

[img]9aYoJ8.png[/img]

Yalnız hocanın 

function DoLogin(const username, password, captcha: string): string;
var
 IdHTTP: TIdHTTP;
 Request: TStringList;
 sourceFile,DestFile : string;
begin
 try
   Request := TStringList.Create;
   try
     Request.Add('action=do_login');
     Request.Add('url=https://optik.sgk.gov.tr/Optik_Firma_Web/login.jsp');

     Request.Add('j_username='+username);
     Request.Add('j_password='+password);
     Request.Add('guvenlikNumarasi='+captcha);
     Request.Add('submit=Giriş Yap');
     IdHTTP := TIdHTTP.Create;
     try
       IdHTTP.AllowCookies := True;
       IdHTTP.HandleRedirects := True;
       IdHTTP.Request.ContentType := 'application/x-www-form-urlencoded';
       IdHTTP.Post('https://optik.sgk.gov.tr/Optik_Firma_Web/', Request);
       Result := IdHTTP.Get('https://optik.sgk.gov.tr/Optik_Firma_Web/');
       if ContainsStr(Result, 'Güvenlik Numarasını Yanlış Girdiniz') then //Login başarısız demektir
         Result := '';
     finally
       IdHTTP.Free;
     end;
   finally
     Request.Free;
   end;
 except
   Result := '';
 end;
end;

fonksiyonu parçalayamadım, dolayısı ile chaptcha yı nereye konumlandıracağımı da bilemedim, malumunuz her bağlantı isteğinde  chaptcha değişiyor

(Sonraki sorun ama programı kapatıp tekrar açmadan yeni chaptcha gelmiyor
InternetSetOption( nil, INTERNET_OPTION_END_BROWSER_SESSION, nil, 0 );
EmbeddedWB1.Navigate( SGK_OptikUrl );
hali hazırda kullandığım uygulamada Muharrem Abi sayesinde böyle halletmiştik)

İlk hedefim doğru bir mantıkla login olmak. Yardımlarınızı rica ediyorum.

Bu konuyu yazdır

  Arapça Yazı Gösterme
Yazar: baloglurecep - 09-02-2019, Saat: 01:50 - Forum: Genel Programlama - Yorumlar (5)

Arkadaşlar selamlar saygılar... okul bilgi programı yazmıştım. Okul koridorlarında büyük led tvlerde çalışlıyor. (hdmi pc bağlantılı) Güncelleme yapıyorum. Ana  ekranda ders programı, nöbetçi öğretmenler, resim slayt alanı, bilgilendirme için kayan yazı var... Kayan yazı kısmında edite girilen veri, namaz saatleri, veri tabanındaki özlü sözleri kullanızı istediğini seçip kullanabiliyor. Bu güncelleme ile kayan yazıya kayma yönü seçeneği de ekledim. Arapça ayet, hadis için. Kayan yazı bileşeni olarak raize adında bileşen setinin RzMarqueeStatus adındaki bileşenini kullandım. Sağdan sola soldan sağa seçenekleri var. Arapça için ideal. Yalnız bir türlü arapça yazıları gerek bu bu bileşende gerekse editlerde gösteremedim. Klavyeden elle yazarsam oluyor fakat kopyala yapıştır yaparsam olmuyor. Windows fonts klasörüne arapça font da yükledim ve bu fontu seçtiğim halde değişmiyor. Yazılar yerinde ?????????????????????????????????????????? işareti çıkıyor. Kullanıcılar kopyala yapıştır yapacaklar. Çünkü arapça klavye kolay kolay bulamazlar ya da yazmakla uğraşmazlar. Sebebini bulamıyorum. Sizce neden olabilir arkadaşlar Nasıl bir yol ile çözebilirim?
Teşekkür eder iyi çalışmalar dilerim DelphiCan dostlarım.

Bu konuyu yazdır

  Android kod akışı farklı mı anlamadığım bir şey mi var ?
Yazar: cinarbil - 08-02-2019, Saat: 17:43 - Forum: Mobil Platform - FireMonkey (FMX) - Yorumlar (7)

İyi akşamlar
Öncelikle yaptığım tüm kodları Delphican sayfasından aradım buldum ve yapmaya çalıştım
Emeği olan tüm arkadaşlara teşekkür ederim.

Android için yazmaya çalıştığım uygulamada  aşağıdaki kod ile barkod okutarak StringGrid e ekliyorum.

if (barcod_varmi(ReadResult.Text)) then
 
komutu ile daha önce eklenmiş mi kontrol ediyorum,  önce  ekliyor sonra kontrol ediyor.
neyi yanlış yapıyorum yardımcı olabilir misiniz;
sorunu resim olarak ekledim.
 

procedure TFrm_okuma.Barcod_coz;
var
 scanBitmap: TBitmap;
 ReadResult: TReadResult;
 gram,kilo,net:string;
 net_rakam:real;
begin
 try
 gram:='';kilo:='';net:='';net_rakam:=0;
 FScanManager := TScanManager.Create(TBarcodeFormat.Auto, nil);
 scanBitmap := TBitmap.Create();
 scanBitmap.Assign(resim.Bitmap);
 ReadResult := nil;
 ReadResult := FScanManager.Scan(scanBitmap);

           if (ReadResult <> nil) then
           begin
           // barkod daha önce kayıtlımı kontrol et
           if (barcod_varmi(ReadResult.Text)) then
           begin
            // barcod_varmi dan true geldi.  İşlem iptal edilsin
            ReadResult.Free;
            scanBitmap.Free;
            exit;
           end;  // kontrol true gelirse atla false gelirse devam et

           Grd_liste.Cells[0,grid_satir] := floattostr(grid_satir+1);
           Grd_liste.Cells[1,grid_satir] := ReadResult.Text;
            


Kontrol fonksiyonu aşağıda 

function TFrm_okuma.barcod_varmi(okunan:string):boolean;
var i:word;
sonuc:boolean;
begin
   // aynı barcod var mı kontrol et
   for i := 0 to Grd_liste.RowCount do
   begin
         if (trim(Grd_liste.Cells[1,i]) = trim(okunan)) then
         begin
                TDialogService.PreferredMode:=TDialogService.TPreferredMode.Platform;
                TDialogService.MessageDialog('Barkod kayıtlı, Tekrar Eklensin mi?', TMsgDlgType.mtConfirmation,
                FMX.Dialogs.mbYesNo, TMsgDlgBtn.mbNo, 0,
                 procedure(const AResult: TModalResult) begin
                   case AResult of
                     mrYes: sonuc:=False; // False giderse aynı kayıt tan ekleyecek
                     mrNo:  sonuc:=True; // true giderse kaıyt eklemeyecek
                   end;
                 end )

         end;  // grid içeriğini test eden if sonu
   end; // for döngü sonu
Result:=sonuc;
end;



Ek Dosyalar Ekran Görüntüleri
   
Bu konuyu yazdır