FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin for Harbour/xHarbour Convert from Delphi code to xHarbour+FWH?
Posts: 1598
Joined: Fri Oct 07, 2005 05:56 PM
Convert from Delphi code to xHarbour+FWH?
Posted: Mon Jun 28, 2010 05:02 PM
Dear All,

I have a job to make a KeyCard interface program with my application. The KeyCard provider give me a sample to write the card in Delphi 6. Then I have to convert Delphi6 to xHarbour+FWH. The sample is in below.
Could anyone give me a guide to convert it.
Thank you in advance for any help and idea.
Code (fw): Select all Collapse
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleServer, HOTELREADERLib_TLB, ComCtrls;

type
  TForm1 = class(TForm)
    Card1: TCard;
    Panel1: TPanel;
    GetNewAuth: TButton;
    CheckLink: TButton;
    IssueCard: TButton;
    ReadCard: TButton;
    CardAuthCode: TButton;
    CancelCard: TButton;
    DownData: TButton;
    Button10: TButton;
    sd: TPanel;
    LabeledEdit2: TLabeledEdit;
    Panel3: TPanel;
    LabMsg: TLabel;
    Combo_CardType: TComboBox;
    Label1: TLabel;
    Combo_LockType: TComboBox;
    LockType: TLabel;
    Combo_Bld: TComboBox;
    Combo_Floor: TComboBox;
    Combo_Room: TComboBox;
    Combo_Clean: TComboBox;
    Combo_SubRoom: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Ed_BgDt: TEdit;
    Ed_CardKey: TEdit;
    Ed_EdDt: TEdit;
    Memo1: TMemo;
    Label10: TLabel;
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure GetNewAuthClick(Sender: TObject);
    procedure CheckLinkClick(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CardAuthCodeClick(Sender: TObject);
    procedure IssueCardClick(Sender: TObject);
    procedure CancelCardClick(Sender: TObject);
    procedure ReadCardClick(Sender: TObject);
    procedure DownDataClick(Sender: TObject);
    procedure Memo1DblClick(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
  private
      x : TCard;
      p_AuthCode: string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{
  AuthCard          1        Authorization Card
  ClockCard         2        Clock Setting Card
  DataCard          3        Reserved for Palmsize Data Collector
  SetCard           4        Programming Card
  DisableCard       5        Disable Card
  CheckoutCard      6        Check Out Card
  EmergencyCard     7        Emergency Card
  ControlCard       8        Control Card
  BuildingCard      9        Building Card
  FloorCard        10        Floor Card
  GuestCard        11        Room Card
  CleaningCard     12        Area Card
  MaintainCard     13        Maintenance Card
  MeetingCard      14        Office Card
  MechanicalKey    15        Mechanical Key
}

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Form1 := nil;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action :=caFree;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  x := TCard.Create(Self);
  x.LockType := 3;
  x.LockSubType := 1;
  x.ToCollector := False;
end;

procedure TForm1.GetNewAuthClick(Sender: TObject);
begin
//  x.LockType := StrToInt(Copy(Combo_LockType.Text,1,1));
  LabeledEdit2.Text := x.NewAuthorizationCode;
 // x.AuthorizationCode := '82E9126726210EB4';  // LabeledEdit2.Text;
end;

procedure TForm1.CheckLinkClick(Sender: TObject);
begin
  LabMsg.Caption := '';  
  if x.LinkOk then
    LabMsg.Caption := 'Check Link is : OK'
  else LabMsg.Caption := 'Check Link is : Failed';
end;

procedure TForm1.CardAuthCodeClick(Sender: TObject);
begin
  p_AuthCode := x.CardAuthCode;
  LabMsg.Caption := 'Current AuthCode is : ' + p_AuthCode;
  GetNewAuth.Enabled := True;
  CheckLink.Enabled := True;
  IssueCard.Enabled := True;
  ReadCard.Enabled := True;
  CancelCard.Enabled := True;
  DownData.Enabled := True;
end;

procedure TForm1.IssueCardClick(Sender: TObject);
begin
     LabMsg.Caption := '';
     x.AuthorizationCode := p_AuthCode;

     x.CardType := StrToInt(Copy(Combo_CardType.Text,1,2));
     x.building := StrToInt(Copy(Combo_Bld.Text,1,2));
     x.Floor    := StrToInt(Copy(Combo_Floor.Text,1,2));
     x.Room     := StrToInt(Copy(Combo_Room.Text,1,2));
     x.cleaning := StrToInt(Copy(Combo_Clean.Text,1,2));
     x.SubRoom  := StrToInt(Copy(Combo_SubRoom.Text,1,2));

     x.CardKey  := StrToDateTime(Ed_CardKey.Text);

     x.startDate  := StrToDateTime(Ed_BgDt.Text);
     x.expireDate := StrToDateTime(Ed_EdDt.Text);
  try
     x.IssueCard;
     showmessage('OK');
  except
     showmessage('Error');
  end;
end;

procedure TForm1.CancelCardClick(Sender: TObject);
begin
  x.AuthorizationCode := p_AuthCode;
  x.CancelCard;
  LabMsg.Caption := '';
end;

procedure TForm1.ReadCardClick(Sender: TObject);
var
  cardType,cardSnr,cardKey,startDate,expireDate,
  building,floor,room,cleaning,SubRoom : string;
begin
   LabMsg.Caption := '';
   x.AuthorizationCode := p_AuthCode;

   x.startDate := Now;
   x.expireDate := Now;
   try
     x.ReadCard;
   except
     on Exception do
       Exit;
   end;

   cardType := IntToStr(x.CardType);
   cardSnr := IntToStr(x.CardSnr);
   cardKey := FormatDateTime('yyyy-MM-dd hh:mm:ss',x.cardKey);
   startDate := FormatDateTime('yyyy-MM-dd hh:mm',x.StartDate);
   expireDate := FormatDateTime('yyyy-MM-dd hh:mm',x.ExpireDate);
   building := IntToStr(x.Building);
   floor := IntToStr(x.Floor);
   room := IntToStr(x.Room);
   cleaning := IntToStr(x.cleaning);
   SubRoom := IntToStr(x.SubRoom);

   LabMsg.Caption := 'cardType: '   + cardType +' ; ' +
                     'cardSnr: '    + cardSnr+' ; '+

                     'cardKey: '    + cardKey+' ; '+ #13 +
                     'startDate: '  + startDate+' ; '+
                     'expireDate: ' + expireDate+' ; '+ #13 +

                     'building: '   + building+' ; '+
                     'floor: '      + floor+' ; '+
                     'room: '       + room+' ; '+
                     'cleaning: '   + cleaning+' ; '+
                     'SubRoom: '    + SubRoom;

   Combo_Bld.Text := building;
   Combo_Floor.Text := floor;
   Combo_Room.Text := room;
   Combo_Clean.Text := cleaning;
   Combo_SubRoom.Text := SubRoom;
   Ed_CardKey.Text := cardKey;
   Ed_BgDt.Text := startDate;
   Ed_EdDt.Text := expireDate;
end;

procedure TForm1.DownDataClick(Sender: TObject);
var
  s : string;
  i,j : integer;
begin
  s := '';

  ProgressBar1.Visible := True;
  ProgressBar1.Position := 65;

  x.ReadEvent;
  j := x.LockEvent.Count;

  Memo1.Clear;
  ProgressBar1.Max := j;
  for i := 1 to j do
  begin
    s := '';
    ProgressBar1.Position := i;
    s := IntToStr(x.LockEvent.Item[i].cardType);
    if Length(s) < 2 then
      s := '0' + s;
    s := s + '    ' + IntToStr(x.LockEvent.Item[i].cardSnr);
    s := s + '    ' + FormatDateTime('yyyy-MM-dd HH:mm:ss',x.LockEvent.Item[i].UnlockTime);
    Memo1.Lines.Add(s);
    Application.ProcessMessages;
  end;
 
  ProgressBar1.Visible := False;
end;

procedure TForm1.Memo1DblClick(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.Memo1Click(Sender: TObject);
begin
  LabMsg.Caption := 'Download Locking Records: ' + IntToStr(Memo1.Lines.Count);
end;

end.
Regards,

Dutch



FWH 2304 / xHarbour Simplex 1.2.3 / BCC73 / Pelles C / UEStudio

FWPPC 10.02 / Harbour for PPC (FTDN)

ADS V.9 / MySql / MariaDB

R&R 12 Infinity / Crystal Report XI R2

(Thailand)

Continue the discussion