unit main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ExtCtrls;
type  TRANF_STATE = (_FREE, _RUNING, _FAIL, _SUCC);
  TScanner=class
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private    ErrString :string;
    No_File:bool;
    save_filename:string;    lpData: Integer;
    pbCancel: Integer;
    m_workDir: string;
    m_nPort: Integer;
    m_nRate: Integer;
    m_bCompress: BOOL;
    m_dl_state: TRANF_STATE;  public    constructor Create;
    function SetComm: Boolean;
    function ReadComm :ShortInt;
    destructor Destroy;
  end;
type
  Tfrmain = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
  myscanner:TScanner;
  public
  end;
  const RAPI_DLL = 'Rapi.dll';
  const NLS_COMM_ERROR = 101;        //连接串口出错。
  const NLS_READFILE_ERROR = 102;    //读取文件出错(也有可能串口原因)。
  const NLS_WRITEFILE_ERROR = 103;    //写文件出错(也有可能串口原因)。
  const NLS_USER_CANCEL = 104;        //用户取消拷贝进程。
  const NLS_OTHER_ERROR = 105;  function NLS_RapiInit(nPort: Integer;nRate: Integer;bCompress: BOOL):HRESULT;
     stdcall; external RAPI_DLL;
  function NLS_RapiUninit():HRESULT; stdcall; external RAPI_DLL;
  function NLS_Ring(music: LPCSTR):Integer;stdcall; external RAPI_DLL;
  function NLS_DeleteFile (lpFileName: LPCSTR):BOOL;stdcall; external RAPI_DLL;
  function NLS_CopyFileEx(lpExistingFileName: LPCSTR;
                          lpNewFileName: LPCSTR;
                          lpProgressRoutine: pointer;
                          lpData: PInteger;
                          pbCancel: PInteger; //PBOOL;
                          dwCopyFlags: DWORD
                         ):BOOL; stdcall; external RAPI_DLL;var
  frmain: Tfrmain;implementation{$R *.dfm}procedure TScanner.Timer1Timer(Sender: TObject);
begin  ErrString := '';
  if (lpData >= 0) and (lpData < 100) then
  begin
    m_dl_state := _RUNING;
    Application.ProcessMessages;
  end
  else
  begin
    m_dl_state := _FAIL;
    case lpData of
      NLS_COMM_ERROR:
      begin
        ErrString := ErrString + #9 + '连接串口出错。';
      end;
      NLS_READFILE_ERROR:
      begin
        ErrString := ErrString + #9 + '读取文件出错,文件不存在或串口原因。';
      end;
      NLS_WRITEFILE_ERROR:
      begin
        ErrString := ErrString + #9 + '写文件出错,可能串口原因。';
      end;
      NLS_USER_CANCEL:
      begin
        ErrString := ErrString + #9 + '用户取消拷贝进程。';
      end;
      NLS_OTHER_ERROR:
      begin
        ErrString := ErrString + #9 + '其它错误。';
      end;
    end;
  end;
  if lpData = 100 then begin
     m_dl_state := _SUCC;
  end;
end;destructor TScanner.Destroy;
begin
  Timer1.Free;
end;function TScanner.ReadComm : ShortInt;
var
  save_filename: string;
  No_File: Boolean;
begin
  result:=0;
  No_File := True;
  frmain.Label1.Caption :='';  m_workDir :=  ExtractFilePath(application.ExeName) + 'rk' + '\';
  if not DirectoryExists(m_workDir) then CreateDir(m_workDir);  ErrString := '';  try    if NLS_RapiInit(m_nPort, m_nRate, m_bCompress) = 0 then
    begin
      raise exception.Create('扫描器数据上传时,初始化失败,请检查参数设置中扫描器相关部分是否正确,与实际是否相符!');
      NLS_RapiUninit();
      exit;
    end;
    if NLS_Ring(PChar('|1.1|')) = 0 then
    begin
      raise Exception.Create('数据上传时,扫描器未在数据上传状态,请使扫描器处于上传状态,并且确定已启动RPC服务!');
      NLS_RapiUninit();
      exit;
    end;
    Application.ProcessMessages;
    m_dl_state := _RUNING;
    lpData := 0;
    pbCancel := 0;
    save_filename := m_workDir + FormatDateTime('yyyymmdd_hhmmss', Now)+'.txt';
    Timer1.Enabled := true;
    if NLS_CopyFileEx(PChar('NLS:\rk.txt'), PChar(save_filename), nil, @lpData, @pbCancel, 0) <> TRUE  then
    begin
      raise exception.Create('上传 rk.txt失败!');
      timer1.Enabled :=false;
      NLS_RapiUninit();
      exit;
    end;
    while m_dl_state=_RUNING do
    begin
      Application.ProcessMessages;
    end;
    Timer1.Enabled := false;
    if m_dl_state = _SUCC then
    begin
      result:=1;
      Timer1.Enabled := false;
      NLS_RapiUninit();
      frmain.Label1.Caption :='上传成功';
      No_File := False;    end
    else
    begin
      Timer1.Enabled := false;
      showmessage( '上传入库数据文件操作出错。');
      NLS_RapiUninit();    end;
  except
    on e:exception do
    begin
      Timer1.Enabled := false;
      NLS_RapiUninit();
      Application.ProcessMessages;
    end;
  end;
end;function TScanner.SetComm: Boolean;
begin
  Result := False;
  try
    m_dl_state := _FREE;
    lpData := 0;
    pbCancel := 0;
    m_nPort := 1;
    m_nRate := 115200;
    m_bCompress := False;
    Result := True;
  except
  end;
end;
constructor TScanner.Create;
begin
 
  Timer1 := TTimer.Create(nil);
  Timer1.Enabled := False;
  Timer1.Interval := 300;
  Timer1.Tag := 0;
  Timer1.OnTimer := Timer1Timer;
end;
procedure Tfrmain.Button1Click(Sender: TObject);begin
    myscanner.Create ;
    if myscanner.SetComm =false then
    begin
       showmessage('设置串口参数时发生错误');
       myscanner.Free ;
       exit;
    end;
    if myscanner.ReadComm =0 then
    begin
      showmessage('读取扫描器文件时发生错误');
      myscanner.Free ;
      exit;
    end;
    myscanner.Free;end;end.