Çok Yakında Yeni Bir Arayüzle karşınızdayız! http://yeni.delphican.com/

Konuyu Oyla:
  • Derecelendirme: 4/5 - 1 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Hex bir değeri, 37 bit integer değere çevirme
#1
Merhaba değerli arkadaşlar;

Başka bir veri tabanından bana gönderilmiş ve içinde kart ID lerinin de olduğu bir excell listesi mevcut. 
USB HID bir okuyucudan kart numarasını okuyorum. 10 karakterlik Hex bir değer dönüyor. Normal bir decimale çevirdiğimde elde ettiğim sayı ile gelen kart ID değerlerinin aynı olmasını beklerken farklı değerler olduğunu tespit ettim.

İnternet'te yaptığım araştırmada, exceldeki rakamın, gelen Hex değerin 37 bit olarak dönüştürülmesi ile elde edildiğini gördüm. Belki ben yanlış yorumladım ama bu 37 bit olayını itiraf edeyim ilk defa duydum. 

Delphi den ben bu convert olayını nasıl yapabilirim ? Tecrübesi yada bilgisi olan var mı ? 

Teşekkürler.

 Hex :11BE893982

Dec:76211108226

Olması gereken Dec : 3745815745
Cevapla
#2
Adem bey merhaba bu konuda size yardımcı olacağım. Suan pc basında değilim. Geçmişte benzer sorunları cozmustum.

İlaveten kart turu mifare mi proximity midir?
Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.

Sadece Hobiciyim..
WWW
Cevapla
#3
Merhaba @Adem Kurt

Verdiğiniz örneklerden yola çıkarak aşağıdaki şekilde ihtiyacınız olan fonksiyonları ekledim.
Ekteki dökümanda detaylı bilgi mevcuttur
Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.

eğer yanlış çözümlemedi isem kullanılan yapı "Standard" 26-Bit Wiegand Formatı

İşlem sırası ile elinizdeki Hex Değer BIN formatına dönüştürülüyor
sonra eldeki BIN içerisinden ilk 4 ve son degerler devre dışı bırakılıyor
Elde kalan ile istediğiniz türlere dönüştürülüyor

   

*DFM
object Form1: TForm1
 Left = 0
 Top = 0
 Caption = 'HID Card Converter'
 ClientHeight = 377
 ClientWidth = 601
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'Tahoma'
 Font.Style = []
 OldCreateOrder = False
 PixelsPerInch = 96
 TextHeight = 13
 object Label1: TLabel
   Left = 8
   Top = 32
   Width = 55
   Height = 13
   Caption = 'Source Hex'
 end
 object Label2: TLabel
   Left = 8
   Top = 120
   Width = 54
   Height = 13
   Caption = 'Source Dec'
 end
 object Label3: TLabel
   Left = 12
   Top = 147
   Width = 50
   Height = 13
   Caption = 'Source Bin'
 end
 object Label4: TLabel
   Left = 8
   Top = 208
   Width = 54
   Height = 13
   Caption = 'Target Hex'
 end
 object Label5: TLabel
   Left = 8
   Top = 248
   Width = 53
   Height = 13
   Caption = 'Target Dec'
 end
 object Label6: TLabel
   Left = 8
   Top = 291
   Width = 49
   Height = 13
   Caption = 'Target Bin'
 end
 object txSHex: TEdit
   Left = 69
   Top = 29
   Width = 121
   Height = 21
   TabOrder = 0
   Text = '11BE893982'
 end
 object btnConvert: TButton
   Left = 68
   Top = 56
   Width = 75
   Height = 25
   Caption = 'Convert'
   TabOrder = 1
   OnClick = btnConvertClick
 end
 object txSDec: TEdit
   Left = 68
   Top = 117
   Width = 121
   Height = 21
   TabOrder = 2
 end
 object txSBin: TEdit
   Left = 68
   Top = 144
   Width = 289
   Height = 21
   TabOrder = 3
 end
 object txTHex: TEdit
   Left = 69
   Top = 205
   Width = 121
   Height = 21
   TabOrder = 4
 end
 object txTDec: TEdit
   Left = 68
   Top = 245
   Width = 121
   Height = 21
   TabOrder = 5
 end
 object txTBin: TEdit
   Left = 64
   Top = 288
   Width = 289
   Height = 21
   TabOrder = 6
 end
end

*PAS
unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   txSHex: TEdit;
   btnConvert: TButton;
   txSDec: TEdit;
   txSBin: TEdit;
   Label1: TLabel;
   Label2: TLabel;
   Label3: TLabel;
   txTHex: TEdit;
   txTDec: TEdit;
   txTBin: TEdit;
   Label4: TLabel;
   Label5: TLabel;
   Label6: TLabel;
   procedure btnConvertClick(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   function fn_HexToInt64(pHexDeger:String):Int64;
   function fn_HexToBin(pHex: string): string;
   function fn_BinToHex(BinStr: string): string;
   function fn_BinToDec(Str: string): Integer;
 end;


const
 BinTable: array [0..15] of string =
  // 0       1       2       3       4       5       6       7       8       9       A       B       C       D       E       F
   ('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111');

var
 Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.fn_HexToInt64(pHexDeger:String):Int64;
var
 I:Integer;
 TempStr : String;
 wflag:Boolean;
begin
 try
   wFlag := False;
   for I := 1 to Length(pHexDeger) do
   begin
     TempStr := pHexDeger;
     if TempStr[I] IN ['0'..'9', 'A'..'F'] then Continue;
     wFlag := True;
     Break;
   end;
   if wFlag = False then
     Result := StrToInt64(('$' + pHexDeger))
   else
     Result := 0;
 except
   Result := 0;
 end;
end;

function TForm1.fn_HexToBin(pHex: string): string;
var
 i: integer;
begin
 Result := '';
 for i := Length(pHex) downto 1 do
   Result := BinTable[StrToInt('$' + pHex[i])] + Result;
end;

function TForm1.fn_BinToHex(BinStr: string): string;
const
 BinArray: array[0..15, 0..1] of string =
   (('0000', '0'), ('0001', '1'), ('0010', '2'), ('0011', '3'),
    ('0100', '4'), ('0101', '5'), ('0110', '6'), ('0111', '7'),
    ('1000', '8'), ('1001', '9'), ('1010', 'A'), ('1011', 'B'),
    ('1100', 'C'), ('1101', 'D'), ('1110', 'E'), ('1111', 'F'));
var
 Error: Boolean;
 j: Integer;
 BinPart: string;
begin
 Result:='';

 Error:=False;
 for j:=1 to Length(BinStr) do
   if not (BinStr[j] in ['0', '1']) then
   begin
     Error:=True;
     ShowMessage('This is not binary number');
     Break;
   end;

 if not Error then
 begin
   case Length(BinStr) mod 4 of
     1: BinStr:='000'+BinStr;
     2: BinStr:='00'+BinStr;
     3: BinStr:='0'+BinStr;
   end;

   while Length(BinStr)>0 do
   begin
     BinPart:=Copy(BinStr, Length(BinStr)-3, 4);
     Delete(BinStr, Length(BinStr)-3, 4);
     for j:=1 to 16 do
       if BinPart=BinArray[j-1, 0] then
         Result:=BinArray[j-1, 1]+Result;
   end;
 end;
end;

function TForm1.fn_BinToDec(Str: string): Integer;
var
 Len, Res, i: Integer;
 Error: Boolean;
 function Pow(i, k: Integer): Integer;
 var
   j, Count: Integer;
 begin
   if k>0 then j:=2
     else j:=1;
   for Count:=1 to k-1 do
     j:=j*2;
   Result:=j;
 end;
begin
 Error:=False;
 Len:=Length(Str);
 Res:=0;
 for i:=1 to Len do
   if (Str[i]='0')or(Str[i]='1') then
     Res:=Res+Pow(2, Len-i)*StrToInt(Str[i])
   else
   begin
     MessageDlg('It is not a binary number', mtInformation, [mbOK], 0);
     Error:=True;
     Break;
   end;
 if Error=True then Result:=0
   else Result:=Res;
end;

procedure TForm1.btnConvertClick(Sender: TObject);

begin
   txSDec.Text := fn_HexToInt64(txSHex.Text).ToString;
   txSBin.Text := fn_HexToBin(txSHex.Text);

   txTBin.Text := Copy(txSBin.Text, 5, (length(txSBin.Text) - 5));
   txTHex.Text := fn_BinToHex(txTBin.Text);
   txTDec.Text := IntToStr(fn_HexToInt64(txTHex.Text));

end;

end.
Bu dünyada kendine sakladığın bilgi ahirette işine yaramaz. 
Cevapla
#4
@adelphiforumz  Hocam benden önce davranmış. Lakin gözden kaçırdığı bir durum var.

37 bit formatta okuma yapan bir okuyucudan gelen datanın 1. ve 37. bitleri Parity bitidir. bunlar çıkartılır ve geriye kalan bitler yanyana birleştirir. Bu data içerisinde "Facility Code" ve "Card ID" yer alır. Eğer baştaki 4 basamağı silerseniz farklı firma üretimi kartlar denk gelirse hatalı bir sonuca dönüştürmüş olursunuz.

ufak bir uygulama yazdım onun üzerinden gidelim.

Elimizdeki sayıyı hex formatında programa girelim ve Dönüştür butonuna basalım.

   

Girilen dataya göre parse işlemi yaparak asıl ulaşmak istediğimiz sonucu gösterir.

Yalnız bu durum 37 bit olarak okuyup HEX formatına dönüştürülmüş kodlar için geçerlidir. eğer okuyucu farklı bir formatta okudu ise ve bunu programa girerseniz hatalı sonuç alacaksınız.

37 bit format aşağıdaki gibidir.

P FFFFFFFFFFFFFFFF CCCCCCCCCCCCCCCCCCC O

P = Parity
O = Odd Parity
F = Facility Code, range = 0 to  65,535
C = Cardholder ID, range = 0 to 524,287

Konu kaynak kodları

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

 { TForm1 }

 TForm1 = class(TForm)
   Button1: TButton;
   Label10: TLabel;
   Label11: TLabel;
   Label12: TLabel;
   Label6: TLabel;
   Label7: TLabel;
   Label8: TLabel;
   Label9: TLabel;
   okunanhex: TEdit;
   okunandec: TEdit;
   P1: TEdit;
   GroupBox1: TGroupBox;
   GroupBox2: TGroupBox;
   Label1: TLabel;
   Label2: TLabel;
   Label3: TLabel;
   Label4: TLabel;
   Label5: TLabel;
   okunanbin: TEdit;
   Fac: TEdit;
   Card: TEdit;
   O1: TEdit;
   SonucBIN: TEdit;
   SonucHEX: TEdit;
   SonucDEC: TEdit;
   procedure Button1Click(Sender: TObject);
   procedure okunanhexKeyPress(Sender: TObject; var Key: char);
 private

 public

 end;

var
 Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

function HexToBin(pHex: string): string;
const
BinTable: array [0..15] of string =
  ('0000', '0001', '0010', '0011',
   '0100', '0101', '0110', '0111',
   '1000', '1001', '1010', '1011',
   '1100', '1101', '1110', '1111');
var
i     : integer;
begin
Result := '';
for i := Length(pHex) downto 1 do
  begin
  Result := BinTable[StrToInt('$' + pHex[i])] + Result;
  end;

// solda varsa sıfırlardan kurtul.

  for i := 1 to Length(Result) do
  begin
    if Result[i] = '1' then
       begin
          Result := Copy(Result,i,length(Result));
          break;
       end;

  end;

end;

function BinToHex(BinStr: string): string;
const
 BinArray: array[0..15, 0..1] of string =
   (('0000', '0'), ('0001', '1'), ('0010', '2'), ('0011', '3'),
    ('0100', '4'), ('0101', '5'), ('0110', '6'), ('0111', '7'),
    ('1000', '8'), ('1001', '9'), ('1010', 'A'), ('1011', 'B'),
    ('1100', 'C'), ('1101', 'D'), ('1110', 'E'), ('1111', 'F'));
var
 Error: Boolean;
 j: Integer;
 BinPart: string;
begin
 Result:='';

 Error:=False;
 for j:=1 to Length(BinStr) do
   if not (BinStr[j] in ['0', '1']) then
   begin
     Error:=True;
     ShowMessage('This is not binary number');
     Break;
   end;

 if not Error then
 begin
   case Length(BinStr) mod 4 of
     1: BinStr:='000'+BinStr;
     2: BinStr:='00'+BinStr;
     3: BinStr:='0'+BinStr;
   end;

   while Length(BinStr)>0 do
   begin
     BinPart:=Copy(BinStr, Length(BinStr)-3, 4);
     Delete(BinStr, Length(BinStr)-3, 4);
     for j:=1 to 16 do
       if BinPart=BinArray[j-1, 0] then
         Result:=BinArray[j-1, 1]+Result;
   end;
 end;
end;

function HextoDec(Hex: string): string;
begin
 result := StrToInt64('$'+Hex).tostring;
end;

function BINtoParity(Bin: string): string;
begin
 result := copy(Bin,1,1);
end;

function BINtoOdd(Bin: string): string;
begin
 result := copy(Bin,37,1);
end;

function BINtoFacilityCode(Bin: string): string;
begin
 result := copy(Bin,2,16);
end;

function BINtoCardID(Bin: string): string;
begin
 result := copy(Bin,18,19);
end;



procedure TForm1.Button1Click(Sender: TObject);

begin
 okunanbin.Text:=HextoBin(okunanhex.text);
 okunandec.Text:=HextoDec(okunanhex.text);

 if length(okunanbin.text) = 37 then
    begin

       P1.Text  := BINtoParity(okunanbin.Text);
       O1.Text  := BINtoOdd(okunanbin.Text);
       Fac.text := BINtoFacilityCode(okunanbin.Text);
       Card.Text:= BINtoCardID(okunanbin.Text);

       SonucBIN.Text:=Fac.Text+Card.Text;
       SonucHEX.Text:=BinToHex(SonucBIN.Text);
       SonucDEC.text:=HextoDec(SonucHEX.Text);

    end
    else
    begin
       P1.clear;
       O1.clear;
       Fac.clear;
       Card.clear;

       SonucBIN.clear;
       SonucHEX.clear;
       SonucDEC.clear;

    end;

end;


procedure TForm1.okunanhexKeyPress(Sender: TObject; var Key: char);
begin
 if not (key in ['0'..'9','.',#8,'A'..'F','a'..'f']) then
 begin
   Key:=#0;
   Beep;
 end;
end;

end.



Lazarus Kaynak Kodları : 
.zip   HID10304.zip (Dosya Boyutu: 1.023,9 KB / İndirme Sayısı: 7)

*** Not : Farklı formatlar için formatını bulup ona göre düzenleme yapılabilir.
Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.

Sadece Hobiciyim..
WWW
Cevapla
#5
Arkadaşlar teşekkür ederim.

Dediğiniz gibi uyarladım, sorunum çözüldü.
Cevapla
#6
@SercanTEK detay bilgi için teşekkürler
Bu dünyada kendine sakladığın bilgi ahirette işine yaramaz. 
Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  C# kodu Delphi ye çevirme dkadir 2 247 28-11-2019, Saat: 15:11
Son Yorum: dkadir
  Comboboxa girilen değere göre veri çekme. bünyamin68 4 414 06-10-2019, Saat: 10:16
Son Yorum: bünyamin68
  Edit Sayı Çevirme OZCANK 13 895 10-09-2019, Saat: 15:43
Son Yorum: faktoral
  Com Porttan gelen veriyi strin formatına çevirme 41linea41 3 619 12-06-2019, Saat: 02:41
Son Yorum: Fesih ARSLAN
  Veri tabanına aynı değeri tekrarlama arsl01 21 1.844 03-05-2019, Saat: 11:34
Son Yorum: edo



Konuyu Okuyanlar: 1 Ziyaretçi