ghcdll.pas

写卡器的串口测试程序, 有delphi的,vb的... 涉用到好几有语言, 还包括说明

unit GHCDLL;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    optSelection: TRadioGroup;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    nTrack: TEdit;
    sOneThree: TEdit;
    sTwo: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
  Treadcard=function(n1:integer;n2:integer;s1:Pchar;s2:Pchar;n3:integer):integer;stdcall;
  Twritecard=function(n1:integer;n2:integer;s1:Pchar;s2:Pchar;n3:integer):integer;stdcall;
  THandle = Integer;
var
  Form1: TForm1;
  readcard: Treadcard;
  writecard:Twritecard;
implementation

{$R *.DFM}

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

procedure TForm1.Button1Click(Sender: TObject);
var
        n,code:Integer;
        sMsg:  String;
        Handle: THandle;
        s1:Array[0..255] of Char;
        s2:Array[0..255] of Char;
        p1:PChar;
        p2:PChar;
begin
        Val(nTrack.Text, n, code);
        if Code <> 0 then
        begin
                MessageDlg('Error at position: ' + IntToStr(Code), mtWarning,[mbOK], 0);
                nTrack.Clear;
                nTrack.SetFocus;
                exit
        end;

        if (n<1) or (n>5) then
        begin
                MessageDlg('Error parameters: Track=' + IntToStr(n), mtWarning, [mbOk], 0);
                nTrack.Clear;
                nTrack.SetFocus;
                exit
        end;

        Handle :=LoadLibrary('ghc715.DLL');
        if Handle <> 0 then
        begin
                @readcard := GetProcAddress(Handle, 'readcard');
                @writecard:= GetProcAddress(Handle, 'writecard');
                if (@readcard = nil) or (@writecard=nil) then
                begin
                        Application.MessageBox('Load Function error','Error',MB_OK);
                        exit
                end;
                if optSelection.Items[optSelection.ItemIndex] = '读' then
                begin
                        Fillchar(s1,sizeof(s1),0);
                        Fillchar(s2,sizeof(s2),0);
                        p1:=@s1;
                        p2:=@s2;
                        code:=readcard(1,n,p1,p2,2);
                        if code<>0 then
                        begin
                                sMsg:=IntToStr(code);
                                Application.MessageBox(Pchar(sMsg),'Error Reading card',MB_OK);
                        end
                        else
                        begin
                                sOneThree.Text:=String(p2);
                                sTwo.Text:=String(p1);
                                Application.MessageBox('Succeed in reading card','Info',MB_OK)
                        end;
                end
                else
                begin
                        StrPCopy(s2,Pchar(sOneThree.Text));
                        StrPCopy(s1,Pchar(sTwo.Text));
                        p1:=@s1;
                        p2:=@s2;
                        code:=writecard(1,n,p1,p2,2);
                        if code<>0 then
                        begin
                                Application.MessageBox(Pchar(IntToStr(code)),'Error Writing card',MB_OK);
                        end
                        else
                                Application.MessageBox('Succeed in reading card','Info',MB_OK);
                end;
                FreeLibrary(Handle);
        end
        else
        begin
                Application.MessageBox('加载动态连接库错误：ghc715.dll','错误',MB_OK);
                exit;
        end;
        end;
end.