动态库调用的问题(vb示例转delphi)

Ankoku

考勤机动态库说明（关于vb的示例）：
说明：所有函数只接受两个参数
参数一：Params结构
参数二：表示硬件类型的数值， 取值[30, 60, 2000, 2100, 2200, 2300, 2600]

Params结构定义
Public Type Params
    Port As String * 3//串口号，[1~255]
    CtrlID As String * 3//设备号，[1~127]
    Params As String * 1024//输入：传递给设备处理的参数表,多参数间以分号分隔,以分号结束
                           //输出：接口返回值
End Type

接口返回值定义
100//调用接口失败
101//不支持该类型设备
102//该设备不支持该接口
103//设备无响应
104//参数错误
105//调用成功
106//串口没打开
107//打开文件错误
108//通讯参数错误，要求重发
109//返回值数据校验错误
110//创建线程错误
111//设备忙

一.IT2100
1.打开串口
声明
Public Declare Function OpenComm Lib "CM60.dll" (ByRef lParam As Params, ByVal sType As Integer) As Integer
调用例子
dim p as Params
dim sType as Integer
dim ret as Long

sType = 2100
p.Port = “001” ‘打开串口一
p.CtrlID = “001”  ‘设备号为1

ret = OpenComm(p, sType)
select case ret
case 100‘打开失败
case 105 ‘打开串口成功
case else
    end select

2.        关闭串口
声明
Public Declare Function CloseComm Lib "CM60.dll" (ByRef lParam As Params, ByVal sType As Integer) As Integer
调用例子
Dim p as Params
Dim sType as Integer
Dim ret as Long

sType=2100
p.Port=”001”    ‘关闭串口一
p.CtrlID=””     ‘设备号忽略

ret=CloseComm(p,sType)
select case ret
        case 100  ‘关闭串口一失败
        case 105  ‘关闭串口一成功
        case else
end select


我现在DELPHI下测试：
unit Ukq;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TParams =  Record
    Port: String[3];
    CtrlID: String[3];                        //设备号，[1~127]
    Params: string[250];
  end ;
pparams=^TParams;


var
  Form1: TForm1;


implementation

{$R *.dfm}
function OpenComm(var lParam:pParams;sType:Integer): Integer;stdcall; external 'CM60.dll' ;
function CloseComm(var lParam:pParams;sType:Integer): Integer;stdcall; external 'CM60.dll';

procedure TForm1.Button1Click(Sender: TObject);
var
  p:pparams;
  sType, ret: Integer;
begin
  sType :=2100;

  new(p);
  p^.Port :=edit1.Text;
  p^.CtrlID :=edit2.Text;

  ret := OpenComm(p,sType);
   showmessage(inttostr(ret));


ret := CloseComm(p, sType);
p^.CtrlID :='';
  showmessage(inttostr(ret));
  dispose(p);

end;
end.
每次测试的结果都返回100(串口打开关闭都失败),在多台机器上都是如此。而用考勤机的终端管理每次能打开串口。

不知道是我的代码哪里有问题？

Ankoku

快来人啊，科密的考勤机

jdiany1985

关注，我也正在搞和这类似的东西。

yc8348

感觉是参数定义的问题，因为没用过VB，不知道如下定义
Public Type Params
    Port As String * 3//串口号，[1~255]
    CtrlID As String * 3//设备号，[1~127]
    Params As String * 1024//输入：传递给设备处理的参数表,多参数间以分号分隔,以分号结束
                           //输出：接口返回值
End Type
是定义字符串啊还是定义数组

把
type
  TParams =  Record
    Port: String[3];
    CtrlID: String[3];                        //设备号，[1~127]
    Params: string[250];
  end ;
改为
type
  TParams =  Record
    Port: array[0..2] of cahr;
    CtrlID: array[0..2] of cahr;                        //设备号，[1~127]
    Params: array[0..1023] of cahr;
  end ;
试试看

narrenschiff

我的代码能打开串口,但不能搜索到设备
unit UIDLL_VAR;

interface
Type Params = record
        Port:array[0..2] of char;
        CtrlID:array[0..2] of char;
        Param:array[0..1023] of char;
        IPPort:array[0..4] of char;
        IPAddr:array[0..15] of char;
End;
Function SearchCtrl( var lParam:Params; sType:integer):integer; stdcall;external 'cm60.dll';
Function OpenComm ( var lParam:Params; sType:integer):integer; stdcall;external 'cm60.dll';
Function CloseComm( var lParam:Params; sType:integer):integer; stdcall;external 'cm60.dll';
Function CollectAll( var lParam:Params; sType:integer):integer; stdcall;external 'cm60.dll';
var
  userid,user_name:string;

implementation

end.
////////////////////
unit URRMTEST;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TFRMTEST = class(TForm)
    Button1: TButton;
    PB1: TProgressBar;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    RB1: TRadioButton;
    RB2: TRadioButton;
    Button2: TButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FRMTEST: TFRMTEST;

implementation
uses
    uidll_var,ufunction;

{$R *.dfm}

procedure TFRMTEST.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    action:=cafree;
end;

procedure TFRMTEST.Button1Click(Sender: TObject);
var
   j,t,b,k,h :integer;
   p:Params;
   s:string;
begin
     if rb1.Checked then
        begin

           p.Port[0]:='0';         
           p.Port[1]:='0';
           p.Port[2]:='1';

           //p.Port:='001';
           P.CtrlID[0]:='0';
           P.CtrlID[1]:='0';
           P.CtrlID[2]:='1';

           p.Param[0]:='9';
           p.Param[1]:='6';
           p.Param[2]:='0';
           p.Param[3]:='0';
           //p.Param[4]:='0';
           //p.Param:='9600';
           j:=2100;
        end
     else
        begin
           p.Port[0]:='0';
           p.Port[1]:='0';
           p.Port[2]:='1';

           P.CtrlID[0]:='0';
           P.CtrlID[1]:='0';
           P.CtrlID[2]:='1';

           p.Param[0]:='1';
           p.Param[1]:='9';
           p.Param[2]:='2';
           p.Param[3]:='0';
           p.Param[4]:='0';
           j:=2201;
        end;
     b:=openComm(p,j);
     showmessage(inttostr(b)+'   OK');
     if b=105 then
        begin
           showmessage('串口打开成功!!');
           k:=1;
           PB1.Max:=strtoint(edit2.Text);
           pb1.Step:= 1;
           while k<= strtoint(edit2.Text) do
              begin
                case k of
                   1:
                      begin
                          P.CtrlID[0]:='0';
                          P.CtrlID[1]:='0';
                          P.CtrlID[2]:='1';
                      end;
                   2: begin
                          P.CtrlID[0]:='0';
                          P.CtrlID[1]:='0';
                          P.CtrlID[2]:='2';
                      end;
                   3: begin
                          P.CtrlID[0]:='0';
                          P.CtrlID[1]:='0';
                          P.CtrlID[2]:='3';
                      end;
                   4: begin
                          P.CtrlID[0]:='0';
                          P.CtrlID[1]:='0';
                          P.CtrlID[2]:='4';
                      end;
                   5: begin
                          P.CtrlID[0]:='0';
                          P.CtrlID[1]:='0';
                          P.CtrlID[2]:='5';
                      end;
                   6: begin
                          P.CtrlID[0]:='0';
                          P.CtrlID[1]:='0';
                          P.CtrlID[2]:='6';
                      end;
                   7: begin
                          P.CtrlID[0]:='0';
                          P.CtrlID[1]:='0';
                          P.CtrlID[2]:='7';
                      end;
                   8: begin
                          P.CtrlID[0]:='0';
                          P.CtrlID[1]:='0';
                          P.CtrlID[2]:='8';
                      end;
                end;
                s:= inttostr(k);
                //showmessage(p.Port+'  '+p.CtrlID);
                p.Param:='';
                b:=SearchCtrl(p,j);
                //showmessage(inttostr(b));
                if b=105 then
                   begin
                      showmessage('成功搜索到设备!!'+s[1]);
                      Break;
                   end
                else
                   begin
                       showmessage('搜索到设备不成功'+s[1]);
                   end;
                pb1.StepIt ;
                //GB2.Caption:= fla(k/strtoint(edit2.Text))+'%' ;
                k:=k+1;
          end ;
          //end ;
        end
  else
      showmessage('串口打开不成功') ;
     //b:=SearchCtrl(p,j);
end;

procedure TFRMTEST.Button2Click(Sender: TObject);
var
s,l:string;
i:integer;
begin
   {以下两中方法均可得到当前应用程序所在的目录}
    getdir(0,s);
    showmessage(s);
    s:=extractfilepath(paramstr(0));
    showmessage(s);
   //**************************************//
   l:=DateTimeToStr(Now);
   showmessage(l);
   showmessage(inttostr(length(l)));
   i:=length(l);
   case i of
       17:
          begin
             s:='data'+copy(l,1,4)+copy('00'+copy(l,6,1),2,2)+copy('00'+copy(l,8,1),2,2)+copy(l,10,2)+copy(l,13,2)+copy(l,15,2);
             showmessage(s);
          end;
       18:
          begin
             s:=copy(l,11,2)+copy(l,14,2)+copy(l,17,2);
             if copy(l,)= then

             showmessage(s);
          end;
       19:
          begin
             s:='data'+copy(l,1,4)+copy('00'+copy(l,6,1),2,2)+copy('00'+copy(l,8,1),2,2)+copy(l,10,2)+copy(l,13,2)+copy(l,15,2);
             showmessage(s);
          end;
   end;
   //showmessage(inttostr(year())) ;
  //showmessage(FormatDateTime('"The meeting is on " dddd, mmmm d, yyyy, " at " hh:mm AM/PM', Now + 0.125));


end;

end.

narrenschiff

不知道是科密的开发库问题还是我自己没有弄对,你如果修改了,可以找到设备。