Programlama yapalım ve Öğrenelim.

Microsoft Binary Format-IEEE (Metastock Data)

Daha çok eski 8087 ve 8088 işlemcilerde kullanılan Microsoft Binary Format'ı Borland Delphi 'nin anlayabileceği data tiplerinden olan IEEE standardına çevirebilmek için kullanabileceğiniz 4 fonksiyon aşağıdadır.

Peki ne işe yarar; bir gün Metastock Dataları ile uğraşacak olursanız benim gibi 24 saat boyunca arama yapmak zorunda kalmazsınız.

Elinizde MBF ile kodlanmış binary datalar varsa bunları Delphi'nin anlayacağı dile çevirebilirsiniz.

{C++ ile yazılmış fonksiyonlardan tercüme edilmiştir.}

// _fmsbintoieee() //4 byte'lık MBF Formatını IEEE Formatına çevirir

// _fieeetomsbin() //4 byte'lık IEEE Formatını MBF Formatına çevirir

// _dmsbintoieee() //8 byte'lık MBF Formatını IEEE Formatına çevirir

// _dieeetomsbin() //8 byte'lık IEEE Formatını MBF Formatına çevirir

// Keyword for Search Machine :

// These functions convert back and forth from Microsoft Binary Format to IEEE floating point format in Delphi.

function _fmsbintoieee(const src4: Single; var dest4: Single): Integer;

var

msbin: array[0..3] of Byte absolute src4;

ieee: array[0..3] of Byte absolute dest4;

sign: Byte;

ieee_exp: Byte;

i: Integer;

begin

(* MS Binary Format *)

(* byte order => m3 | m2 | m1 | exponent *)

(* m1 is most significant byte => sbbb|bbbb *)

(* m3 is the least significant byte *)

(* m = mantissa byte *)

(* s = sign bit *)

(* b = bit *)

sign := msbin[2] and $80; (* 1000|0000b *)

(* IEEE Single Precision Float Format *)

(* m3 m2 m1 exponent *)

(* mmmm|mmmm mmmm|mmmm emmm|mmmm seee|eeee *)

(* s = sign bit *)

(* e = exponent bit *)

(* m = mantissa bit *)

for i := 0 to 3 do

ieee[i] := 0;

(* any msbin w/ exponent of zero = zero *)

if msbin[3] = 0 then

begin

Result := 0;

Exit;

end;

ieee[3] := ieee[3] or sign;

(* MBF is bias 128 and IEEE is bias 127. ALSO, MBF places *)

(* the decimal point before the assumed bit, while *)

(* IEEE places the decimal point after the assumed bit. *)

ieee_exp := msbin[3] - 2; (* actually, msbin[3]-1-128+127 *)

(* the first 7 bits of the exponent in ieee[3] *)

ieee[3] := ieee[3] or (ieee_exp shr 1);

(* the one remaining bit in first bin of ieee[2] *)

ieee[2] := ieee[2] or (ieee_exp shl 7);

(* 0111|1111b : mask out the msbin sign bit *)

ieee[2] := ieee[2] or (msbin[2] and $7f);

ieee[1] := msbin[1];

ieee[0] := msbin[0];

Result := 0;

end;

function _fieeetomsbin(const src4: Single; var dest4: Single): Integer;

var

ieee: array[0..3] of Byte absolute src4;

msbin: array[0..3] of Byte absolute dest4;

sign: Byte;

msbin_exp: Byte;

i: Integer;

begin

msbin_exp := 0;

(* See _fmsbintoieee() for details of formats *)

sign := ieee[3] and $80;

msbin_exp := msbin_exp or (ieee[3] shl 1);

msbin_exp := msbin_exp or (ieee[2] shr 7);

(* An ieee exponent of 0xfe overflows in MBF *)

if msbin_exp = $fe then

begin

Result := 1;

Exit;

end;

msbin_exp := msbin_exp + 2; (* actually, -127 + 128 + 1 *)

for i := 0 to 3 do

msbin[i] := 0;

msbin[3] := msbin_exp;

msbin[2] := msbin[2] or sign;

msbin[2] := msbin[2] or (ieee[2] and $7f);

msbin[1] := ieee[1];

msbin[0] := ieee[0];

Result := 0;

end;

function _dmsbintoieee(const src8: Double; var dest8: Double): Integer;

var

msbin: array[0..7] of Byte;

ieee: array[0..7] of Byte absolute dest8;

sign: Byte;

ieee_exp: Byte;

i: Integer;

begin

(* A manipulatable copy of the msbin number *)

Move(src8, msbin, 8);

(* MS Binary Format *)

(* byte order => m7 | m6 | m5 | m4 | m3 | m2 | m1 | exponent *)

(* m1 is most significant byte => smmm|mmmm *)

(* m7 is the least significant byte *)

(* m = mantissa byte *)

(* s = sign bit *)

(* b = bit *)

sign := msbin[6] and $80; (* 1000|0000b *)

(* IEEE Single Precision Float Format *)

(* byte 8 byte 7 byte 6 byte 5 byte 4 and so on *)

(* s = sign bit *)

(* e = exponent bit *)

(* m = mantissa bit *)

for i := 0 to 7 do

ieee[i] := 0;

(* any msbin w/ exponent of zero = zero *)

if msbin[7] = 0 then

begin

Result := 0;

Exit;

end;

ieee[7] := ieee[7] or sign;

(* MBF is bias 128 and IEEE is bias 1023. ALSO, MBF places *)

(* the decimal point before the assumed bit, while *)

(* IEEE places the decimal point after the assumed bit. *)

ieee_exp := msbin[7] - 128 - 1 + 1023;

(* First 4 bits of the msbin exponent *)

(* go into the last 4 bits of ieee[7] *)

ieee[7] := ieee[7] or (ieee_exp shr 4);

(* The last 4 bits of msbin exponent *)

(* go into the first 4 bits of ieee[6] *)

ieee[6] := ieee[6] or (ieee_exp shl 4);

(* The msbin mantissa must be shifted to the right 1 bit. *)

(* Remember that the msbin number has its bytes reversed. *)

for i := 6 downto 1 do

begin

msbin[i] := msbin[i] shl 1;

msbin[i] := msbin[i] or (msbin[i - 1] shr 7);

end;

msbin[0] := msbin[0] shl 1;

(* Now the mantissa is put into the ieee array starting in *)

(* the middle of the second to last byte. *)

for i := 6 downto 1 do

begin

ieee[i] := ieee[i] or (msbin[i] shr 4);

ieee[i - 1] := ieee[i - 1] or (msbin[i] shl 4);

end;

ieee[0] := ieee[0] or (msbin[0] shr 4);

(* IEEE has a half byte less for its mantissa. If the msbin *)

(* number has anything in this last half byte, then there is *)

(* an overflow. *)

if (msbin[0] and $0f) > 0 then

Result := 1

else

Result := 0;

end;

function _dieeetomsbin(const src8: Double; var dest8: Double): Integer;

var

ieee: array[0..7] of Byte;

msbin: array[0..7] of Byte absolute dest8;

sign: Byte;

any_on: Byte;

msbin_exp: SmallInt;

i: Integer;

begin

any_on := 0;

(* Make a clobberable copy of the source number *)

Move(src8, ieee, 8);

for i := 0 to 7 do

msbin[i] := 0;

(* If all are zero in src8, the msbin should be zero *)

for i := 0 to 7 do

any_on := any_on or ieee[i];

if any_on = 0 then

begin

Result := 0;

Exit;

end;

sign := ieee[7] and $80;

msbin[6] := msbin[6] or sign;

msbin_exp := (ieee[7] and $7f) * $10;

msbin_exp := msbin_exp + (ieee[6] shr 4);

if (msbin_exp - $3ff) > $80 then

begin

Result := 1;

Exit;

end;

msbin[7] := msbin_exp - $3ff + $80 + 1;

(* The ieee mantissa must be shifted up 3 bits *)

ieee[6] := ieee[6] and $0f; (* mask out the exponent in the second byte *)

for i := 6 downto 1 do

begin

msbin[i] := msbin[i] or (ieee[i] shl 3);

msbin[i] := msbin[i] or (ieee[i - 1] shr 5);

end;

msbin[0] := msbin[0] or (ieee[0] shl 3);

Result := 0;

end;

end.

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

Ayrıntılı Bilgi için (For more Information) : swordtur@yahoo.com

Delphi - .....................................

bilgisayara USB nin takılıp sökülmesini algılayan bileşen(component)

toxema:

kodbankta bunun aynısı var fakat birkaç yeri eksik

componenti install ettiğinizde component listesin de gözük müyor

bu o kodların tamamlanmış halidir ben denedim çok güzel çalışıyo.

hadi kolay gelsin.

*********************************************

unit U_Usb;

interface

uses

Windows, Messages, SysUtils, Classes, Forms;

type

PDevBroadcastHdr = ^DEV_BROADCAST_HDR;

DEV_BROADCAST_HDR = packed record

dbch_size: DWORD;

dbch_devicetype: DWORD;

dbch_reserved: DWORD;

end;

PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;

DEV_BROADCAST_DEVICEINTERFACE = record

dbcc_size: DWORD;

dbcc_devicetype: DWORD;

dbcc_reserved: DWORD;

dbcc_classguid: TGUID;

dbcc_name: short;

end;

const

GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';

DBT_DEVICEARRIVAL = $8000; // system detected a new device

DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone

DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class

type

TComponentUSB = class(TComponent)

private

FWindowHandle: HWND;

FOnUSBArrival: TNotifyEvent;

FOnUSBRemove: TNotifyEvent;

procedure WndProc(var Msg: TMessage);

function USBRegister: Boolean;

protected

procedure WMDeviceChange(var Msg: TMessage); dynamic;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;

property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;

end;

procedure Register;

implementation

procedure Register; { add this in the implementation section }

begin

RegisterComponents('Samples', [TComponentUSB]);

end;

constructor TComponentUSB.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FWindowHandle := AllocateHWnd(WndProc);

USBRegister;

end;

destructor TComponentUSB.Destroy;

begin

DeallocateHWnd(FWindowHandle);

inherited Destroy;

end;

procedure TComponentUSB.WndProc(var Msg: TMessage);

begin

if (Msg.Msg = WM_DEVICECHANGE) then

begin

try

WMDeviceChange(Msg);

except

Application.HandleException(Self);

end;

end

else

Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);

end;

procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);

var

devType: Integer;

Datos: PDevBroadcastHdr;

begin

if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then

begin

Datos := PDevBroadcastHdr(Msg.lParam);

devType := Datos^.dbch_devicetype;

if devType = DBT_DEVTYP_DEVICEINTERFACE then

begin // USB Device

if Msg.wParam = DBT_DEVICEARRIVAL then

begin

if Assigned(FOnUSBArrival) then

FOnUSBArrival(Self);

end

else

begin

if Assigned(FOnUSBRemove) then

FOnUSBRemove(Self);

end;

function TComponentUSB.USBRegister: Boolean;

var

dbi: DEV_BROADCAST_DEVICEINTERFACE;

Size: Integer;

r: Pointer;

begin

Result := False;

Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);

ZeroMemory(@dbi, Size);

dbi.dbcc_size := Size;

dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;

dbi.dbcc_reserved := 0;

dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;

dbi.dbcc_name := 0;

r := RegisterDeviceNotification(FWindowHandle, @dbi,

DEVICE_NOTIFY_WINDOW_HANDLE

);

if Assigned(r) then Result := True;

end;

end.

Delphi - .....................................

bilgisayara USB nin takılıp sökülmesini algılayan bileşen(component)

toxema:

kodbankta bunun aynısı var fakat birkaç yeri eksik

componenti install ettiğinizde component listesin de gözük müyor

bu o kodların tamamlanmış halidir ben denedim çok güzel çalışıyo.

hadi kolay gelsin.

*********************************************

unit U_Usb;

interface

uses

Windows, Messages, SysUtils, Classes, Forms;

type

PDevBroadcastHdr = ^DEV_BROADCAST_HDR;

DEV_BROADCAST_HDR = packed record

dbch_size: DWORD;

dbch_devicetype: DWORD;

dbch_reserved: DWORD;

end;

PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;

DEV_BROADCAST_DEVICEINTERFACE = record

dbcc_size: DWORD;

dbcc_devicetype: DWORD;

dbcc_reserved: DWORD;

dbcc_classguid: TGUID;

dbcc_name: short;

end;

const

GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';

DBT_DEVICEARRIVAL = $8000; // system detected a new device

DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone

DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class

type

TComponentUSB = class(TComponent)

private

FWindowHandle: HWND;

FOnUSBArrival: TNotifyEvent;

FOnUSBRemove: TNotifyEvent;

procedure WndProc(var Msg: TMessage);

function USBRegister: Boolean;

protected

procedure WMDeviceChange(var Msg: TMessage); dynamic;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;

property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;

end;

procedure Register;

implementation

procedure Register; { add this in the implementation section }

begin

RegisterComponents('Samples', [TComponentUSB]);

end;

constructor TComponentUSB.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FWindowHandle := AllocateHWnd(WndProc);

USBRegister;

end;

destructor TComponentUSB.Destroy;

begin

DeallocateHWnd(FWindowHandle);

inherited Destroy;

end;

procedure TComponentUSB.WndProc(var Msg: TMessage);

begin

if (Msg.Msg = WM_DEVICECHANGE) then

begin

try

WMDeviceChange(Msg);

except

Application.HandleException(Self);

end;

end

else

Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);

end;

procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);

var

devType: Integer;

Datos: PDevBroadcastHdr;

begin

if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then

begin

Datos := PDevBroadcastHdr(Msg.lParam);

devType := Datos^.dbch_devicetype;

if devType = DBT_DEVTYP_DEVICEINTERFACE then

begin // USB Device

if Msg.wParam = DBT_DEVICEARRIVAL then

begin

if Assigned(FOnUSBArrival) then

FOnUSBArrival(Self);

end

else

begin

if Assigned(FOnUSBRemove) then

FOnUSBRemove(Self);

end;

function TComponentUSB.USBRegister: Boolean;

var

dbi: DEV_BROADCAST_DEVICEINTERFACE;

Size: Integer;

r: Pointer;

begin

Result := False;

Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);

ZeroMemory(@dbi, Size);

dbi.dbcc_size := Size;

dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;

dbi.dbcc_reserved := 0;

dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;

dbi.dbcc_name := 0;

r := RegisterDeviceNotification(FWindowHandle, @dbi,

DEVICE_NOTIFY_WINDOW_HANDLE

);

if Assigned(r) then Result := True;

end;

end.

Delphi - .....................................

SİTE YÖNETİCİSİNE

ARKADŞLAR KUSURA BAKMAYIN MECBUR KALDIM BURAYA YAZMAYA..

..................................... Adresine Giriyorum

Formda Soruları Cevaplamaya ve ya Okumaya calışıyorum .

Ama Güvenlik Sertifikası Diye Bir Bir Hata Veriyor Yardımcı Olabilirseniz Sevinirm..

Rahatsızlık Verdiğimden Dolayı Özür Diliyorum...

Delphi - .....................................

SİTE YÖNETİCİSİNE

ARKADŞLAR KUSURA BAKMAYIN MECBUR KALDIM BURAYA YAZMAYA..

..................................... Adresine Giriyorum

Formda Soruları Cevaplamaya ve ya Okumaya calışıyorum .

Ama Güvenlik Sertifikası Diye Bir Bir Hata Veriyor Yardımcı Olabilirseniz Sevinirm..

Rahatsızlık Verdiğimden Dolayı Özür Diliyorum...

Delphi - .....................................

Dbgrid içerisinde mousun scrool tuşunun kullanımı

//bu kodu anaforma koymanız yeterli

procedure Tanafr.ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

var

i: SmallInt;

begin

if Msg.message = WM_MOUSEWHEEL then

begin

Msg.message := WM_KEYDOWN;

Msg.lParam := 0;

i := HiWord(Msg.wParam) ;

if i > 0 then

Msg.wParam := VK_UP

else

Msg.wParam := VK_DOWN;

Handled := False;

end;

Delphi - .....................................

Dbgrid içerisinde mousun scrool tuşunun kullanımı

//bu kodu anaforma koymanız yeterli

procedure Tanafr.ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

var

i: SmallInt;

begin

if Msg.message = WM_MOUSEWHEEL then

begin

Msg.message := WM_KEYDOWN;

Msg.lParam := 0;

i := HiWord(Msg.wParam) ;

if i > 0 then

Msg.wParam := VK_UP

else

Msg.wParam := VK_DOWN;

Handled := False;

end;

Delphi - .....................................

KOD BANK ÖNERİ !!!

YA ARKADAŞLAR KODBANK PROGRAMININ ARAMASI ÇOK KÖTÜÜ !

ÖRNEĞİN ATIYORUM "TABLO KAYIT SAYISI" YAZIYORSUN ALAKALI ALAKASIZ

NE VARSA BULUYOR VE AYIKLAMAK ÇOK ZOR OLUYOR,EXCEL YAZIYORSUN

NEREDEYSE MEVCUT TUM KAYITLAR CIKIYOR ! HARF HARF ARIYOR SANKI..

BU BIR SIKAYIT DEGİL ONERI,BURAYA YAZDIGIM ICIN TUM ARKADASLARDAN OZURDILERIM LUTFEN BU ARAMA OLAYINA BIR ÇOZUM BULUNSUN.

EMINIM BENIM GIBI BIRCOK ARKADAS AYNI SEYI DUSUNUYOR...

KOLAY GELSIN HERKESE..

Rumuz : Rumuz_Yok

Delphi - .....................................

KOD BANK ÖNERİ !!!

YA ARKADAŞLAR KODBANK PROGRAMININ ARAMASI ÇOK KÖTÜÜ !

ÖRNEĞİN ATIYORUM "TABLO KAYIT SAYISI" YAZIYORSUN ALAKALI ALAKASIZ

NE VARSA BULUYOR VE AYIKLAMAK ÇOK ZOR OLUYOR,EXCEL YAZIYORSUN

NEREDEYSE MEVCUT TUM KAYITLAR CIKIYOR ! HARF HARF ARIYOR SANKI..

BU BIR SIKAYIT DEGİL ONERI,BURAYA YAZDIGIM ICIN TUM ARKADASLARDAN OZURDILERIM LUTFEN BU ARAMA OLAYINA BIR ÇOZUM BULUNSUN.

EMINIM BENIM GIBI BIRCOK ARKADAS AYNI SEYI DUSUNUYOR...

KOLAY GELSIN HERKESE..

Rumuz : Rumuz_Yok

Delphi - .....................................

Ping Atma Fonksiyonu

// Bir arkadaş ping atma için örnek istemiş

// kubilay

// ICMP: TIdIcmpClient;

Function TAnaForm.PingAt(IP:String):Integer;

Var X:Byte;

Begin

ICMP.ReceiveTimeout := 1000;

try

ICMP.Host := IP;

for X:=1 to 4 do ICMP.Ping;

Application.ProcessMessages;

finally

end;

if SonucByte <> 0 then PingAt:=1 else PingAt:=0;

end;

Delphi - .....................................

Ping Atma Fonksiyonu

// Bir arkadaş ping atma için örnek istemiş

// kubilay

// ICMP: TIdIcmpClient;

Function TAnaForm.PingAt(IP:String):Integer;

Var X:Byte;

Begin

ICMP.ReceiveTimeout := 1000;

try

ICMP.Host := IP;

for X:=1 to 4 do ICMP.Ping;

Application.ProcessMessages;

finally

end;

if SonucByte <> 0 then PingAt:=1 else PingAt:=0;

end;

Delphi - .....................................

Yıllar sonra Tekrardan merhaba

Sevgili programcı arkadaşlarım buraya minik bazı şeyler yazacağım.

Bunları yazmamın nedeni bir arkadaşımın burda olanları bana anlatması.

Umarım bu yazdıklarımı gerçekten kayda alır ve önemsersiniz.

Bu site ilk kurulduğu zamanlarda burdaydım. Bu site veya bu platform

gercekten Delphi programları için bir nimet bu sistemi ilk kullananlar

bilirlerki turkiyedeki hiç bir kitapta bir sql cümleciginin içine nasıl

parametrik olarak bilgi gönderilir. Bilinmez hatta çoğu programcı bunu

saklardı. Ama burdaki değerli arkadaşlar bütün bilgilerini paylaştılar.

Bende elimden geldiğince bunu yaptım. Ama yine böyle bir çatışma sonucunda

sistemi bıraktım. Programcılara bilgilerimi açmayı bırakmadım. o dönem C# diline

geçtim ve C# üzerine mobil ortam makaleleri (Csharpnedir.com) yayınladım.

Ama burda benim senin onun yaptıkları önemli değil. Biz burda Turk programcılıgı

gelişsin diye uğraşmıyormuyuz.Neden birbirimize düşelim. Bakın benim Robert Burdick

isminde bir dostum var. Abd de en cok satan Wince kitabının yazarı bazen gelir. Benden fikir

alır. Yaa diyorum sen benden cok daha iyisin olsun diyor.Fikir fikirden üstün olabilir.

Bakıyorumki

adamlar paylaşımcı ve birbirlerini yemiyorlar. Halen delphide kod yazıyorum.Ama C# benim için ayrı.

C++ tada yazdığım kodlarımda var.Önemli olan dil değil sizin programlama mantıgınız ve tekniginiz.

Ve bakıyorum ki hergün kod teknigim

dahada gelişiyor. Bu işin yaşla üniversite eğitimiylede ilgisi yok. Kendini geliştirmekle

ilgisi var. (Tabii ki üniversitedeki arkadaşlar terimler ve bazı teknik

konulara daha hakim oluyorlar. Buda bir gercek)

Fazla söze ne hacet böyle bir platformunuz var.

Lütfen değerini bilin

Sevgi ve saygılar

Sürçi Lisan ettiysem affedin

Kubilay Kulaoğlu

Delphi - .....................................