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.
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.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货