📄 device.pas
字号:
unit Device;
interface
uses
SysUtils, Dialogs, Windows, DeviceCom, ControlFile, ClientConfig, SplPrint,
ErrCode, Writelog, Jpeg, DevicStruct,Forms,Classes, Graphics, Controls , IdHTTP,
DelphiTwain;
{ TODO : sun 2006-06-21 国光加密密码键盘修改 }
const
DLL_Name = 'PinPad_Dll.dll';
type
TdcDevice = class(TComponent)
private
protected
//begin For Scanner 2006.6.28 jkx
FSelectedDSource : Integer;
FScannerJPG : TJPEGImage;
FScannerTwain : TDelphiTwain;
FRemotePort : String;
FRemoteIPAddr : String;
FRemoteURL : String;
FScannered : boolean;
FHttp : TIDHTTP;
//end For Scanner 2006.6.28
writelog: TdcWritelog; //新添加日志类
FDeviceCom: TdcDeviceCom;
FDeviceMsg: TdcCfgMsgStru;
FControlFile: TdcControlFile;
FClientConfig: TdcClientConfig;
FDataBuf: string;
{ TODO : sun 2006-06-21 国光加密密码键盘修改 }
hComm:Integer;
function OpenOrCloseBP(const OutData: string): integer;
{ TODO : 2005-05-24 修改新大陆/实达密码键盘 }
function readComData(): integer; overload; //读串口数据
{ TODO : 2005-05-24 修改新大陆/实达密码键盘 }
function readComData(const DevType: char): integer; overload;
//读串口数据
function sendComData(const DevType: char; const OutData: string): integer; //发送串口数据
function getConfigPath: string; //获得配置文件路径
procedure setConfigPath(Value: string); //设置配置文件路径
procedure SetUseCharDrv(Value: boolean);
function GetUseCharDrv: boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override; //析构函数
function Open(const DevType: char): integer; //打开端口
function Close: integer; //关闭端口
function Control(const Option, OutData: string): integer; //外设控制
function Read(const Option: string): integer; //外设输入
function Write(const Option, OutData: string): integer; //外设输出
{ TODO : sun 2006-06-21 国光加密密码键盘修改 }
function Read_keypad(Comm,Option: PChar): integer;
// For Scanner 2006.6.28 jkx
function PostFileToRemoteHost(AFileName: String): boolean;
function PostImgToRemoteHost: boolean;
function Do_getScannerImage(ShowScannerUI: boolean): Integer;
function getScannerImage(ShowScannerUI:Boolean):Integer;
procedure selScannerDS;
procedure ConfigScanner;
function InitScanner: boolean;
procedure SaveToAFile(AfileName:String);
procedure LoadFromAFile(AfileName:String);
procedure TwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap;
var Cancel: Boolean);
published
property useCharDrv: boolean read GetUseCharDrv write SetUseCharDrv;
property DeviceMsg: TdcCfgMsgStru read FDeviceMsg write FDeviceMsg;
property ConfigPath: string read getConfigPath write setConfigPath;
property RemotePort: String read FRemotePort write FRemotePort;
property RemoteURL: String read FRemoteURL write FRemoteURL;
property RemoteIPAddr: String read FRemoteIPAddr write FRemoteIPAddr;
//配置文件路径
property DataBuf: string read FDataBuf write FDataBuf; //串口返回数据
end;
implementation
{ TODO : sun 2006-06-21 国光加密密码键盘修改 }
function InitComm(Sett:PChar):Integer;stdcall;external DLL_Name;//初始化串口
function CloseComm(hComm:Integer):Integer;stdcall;external DLL_Name;// 关闭串口
function Read_Pwd(hComm:Integer;Cmd:Integer;KeyData:PChar):Integer;stdcall;external DLL_Name ; //明文请输入密码
//构造
constructor TdcDevice.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FDeviceMsg.DevType := 'n'; //设备类型
FDeviceMsg.Company := ''; //厂商
FDeviceMsg.Module := ''; //型号
FDeviceMsg.Version := ''; //版本
FDeviceMsg.DevTypeName := ''; //设备类型名称
FDeviceMsg.CompanyName := ''; //厂商名称
FDeviceMsg.ModuleName := ''; //型号名称
FDeviceMsg.VersionName := ''; //版本名称
FDeviceMsg.BPUse := False; //使用串扩 True 连接扩展盒 False直接连串口
FDeviceMsg.BPConnected := False; //串口扩展盒选通标记 True:已经选通
FDeviceMsg.BPOpenEscCmdStr := ''; //选通串口扩展盒ESC序列
FDeviceMsg.BPCloseEscCmdStr := ''; //关闭串口扩展盒ESC序列
FDeviceMsg.COMPort := 0; //联接端口号
FDeviceMsg.COMPortSpeed := 6; //连接速率
FDeviceMsg.COMParity := 0; //奇偶检验 {n:NONE, o:ODD, e:EVEN, m:MARK, s:SPACE }
FDeviceMsg.COMDataBit := 2; //数据位
FDeviceMsg.COMStopBit := 0; //停止位
FDeviceMsg.COMTimeOut := 30; //超时时间
FDeviceMsg.DrvFileName := '';
FControlFile := TdcControlFile.Create;
//FControlFile.usCharDrv:=true;
FControlFile.usCharDrv := False;
FClientConfig := TdcClientConfig.Create;
FDeviceCom := TdcDeviceCom.Create(FDeviceCom);
writelog := TdcWritelog.Create;
// for scanner
FSelectedDSource:=-1;
FScannerTwain := TDelphiTwain.Create(AOwner);
FScannerTwain.OnTwainAcquire :=TwainAcquire;
FScannerJPG := TJPEGImage.Create;
FHttp := TIDHTTP.Create(AOwner);
FScannered:=False;
end;
//Begin For Scanner 2006.6.28 jkx
procedure TdcDevice.TwainAcquire(Sender: TObject; const Index: Integer;
Image: TBitmap; var Cancel: Boolean);
begin
FScannerJPG.Assign(Image);
FScannered := True;
end;
function TdcDevice.getScannerImage(ShowScannerUI:boolean):Integer;
var
nValue : Integer;
begin
Result:=0;
FScannered := False;
try
nValue := Do_getScannerImage(ShowScannerUI);
if nValue=1 then begin
while not FScannered do Application.ProcessMessages;
// have got the image!
Result:=1;
end;
except
;
end;
end;
function TdcDevice.Do_getScannerImage(ShowScannerUI:boolean):Integer;
var
AtmpBool : Boolean;
begin
result:=0;
if not FScannerTwain.LibraryLoaded then FScannerTwain.LoadLibrary;
if not FScannerTwain.LibraryLoaded then begin
Showmessage('Twain is not installed.');
Exit;
end;
if FSelectedDSource=-1 then begin
FScannerTwain.SourceManagerLoaded := TRUE;
FSelectedDSource := FScannerTwain.SelectSource;
end;
if FSelectedDSource <> -1 then
begin
try
FScannerTwain.Source[FSelectedDSource].Loaded := TRUE;
FScannerTwain.Source[FSelectedDSource].TransferMode := ttmMemory;
FScannerTwain.Source[FSelectedDSource].ShowUI := ShowScannerUI;
AtmpBool := FScannerTwain.Source[FSelectedDSource].EnableSourceByJKX(ShowScannerUI,FScannerTwain.Source[FSelectedDSource].Modal);
if AtmpBool then Result:=1;
except
;
end;
end;
end;
procedure TdcDevice.selScannerDS;
begin
FScannerTwain.SourceManagerLoaded := TRUE;
FSelectedDSource:=FScannerTwain.SelectSource;
end;
procedure TdcDevice.ConfigScanner;
begin
if not FScannerTwain.LibraryLoaded then FScannerTwain.LoadLibrary;
FScannerTwain.SourceManagerLoaded := TRUE;
FSelectedDSource := FScannerTwain.SelectSource;
if FSelectedDSource <> -1 then
begin
FScannerTwain.Source[FSelectedDSource].Loaded := True;
FScannerTwain.Source[FSelectedDSource].ShowUI := True;
FScannerTwain.Source[FSelectedDSource].Enabled := True;
end;
end;
function TdcDevice.InitScanner:boolean;
begin
if not FScannerTwain.LibraryLoaded then FScannerTwain.LoadLibrary;
Result := FScannerTwain.LibraryLoaded;
end;
function TdcDevice.PostFileToRemoteHost(AFileName:String):boolean;
var
tmpStream,
Source: TMemoryStream;
Response: TStringStream;
nIndex,t,
Asize : Integer;
BSize : String;
AFileExt : String;
tmpFileExt : Array [0..99] of char;
begin
Result:=False;
if AFileName='' then exit;
AFileExt := ExtractFileName(AFileName);
if AFileExt='' then Exit;
FHttp.Request.Username := '';
FHttp.Request.Password := '';
FHttp.Request.ProxyServer := FRemoteIPAddr;
FHttp.Request.ProxyPort := StrToIntDef(FRemotePort, 80);
FHttp.Request.ContentType := '';
tmpStream := TMemoryStream.Create;
Response := TStringStream.Create('');
try
for nIndex:=0 to 99 do tmpFileExt[nIndex]:= #0;
for nIndex:=0 to length(AFileExt)-1 do begin
tmpFileExt[nIndex]:= AFileExt[nIndex+1];
end;
// http://192.168.161.162:7001/frame/scanupload.jsp
Source := TMemoryStream.Create;
try
tmpStream.LoadFromFile(AFileName);
Asize := tmpStream.Size;
Source.WriteBuffer(Asize,4);
Asize := Length(AFileExt);
Source.WriteBuffer(Asize,4);
Source.WriteBuffer(tmpFileExt,Asize);
Source.CopyFrom(tmpStream,0);
//Source.SaveToFile('c:\a.txt');
FHttp.Post(FRemoteURL, Source, Response);
Result:=True;
finally
Source.Free;
end;
finally
Response.Free;
tmpStream.free;
end;
end;
function TdcDevice.PostImgToRemoteHost:boolean;
var
Asize : Integer;
tmpFileName : String;
begin
Result := False;
Randomize;
Asize := random(1000);
tmpFileName := 'C:\digitalchina'+IntToStr(Asize)+'.jpg';
FScannerJPG.SaveToFile(tmpFileName);
try
PostFileToRemoteHost(tmpFileName);
Result := True;
finally
DeleteFile(PChar(tmpFileName));
end;
end;
procedure TdcDevice.LoadFromAFile(AfileName: String);
var
ABMP : TBITMAP;
AExt : String;
begin
AExt := ExtractFileExt(AfileName);
if (UpperCase(AExt)='.JPG') or (UpperCase(AExt)='.JPEG') then
FScannerJPG.LoadFromFile(AfileName)
else if UpperCase(AExt)='.BMP' then begin
ABMP := TBITMAP.Create;
try
ABMP.LoadFromFile(AfileName);
FScannerJPG.Assign(ABMP);
finally
ABMP.free;
end;
end else
ShowMessage('文件格式不能被识别!');
end;
procedure TdcDevice.SaveToAFile(AfileName: String);
begin
FScannerJPG.SaveToFile(AfileName);
end;
//END For Scanner 2006.6.28 jkx
//析构
destructor TdcDevice.Destroy;
begin
FScannerTwain.Destroy;
FControlFile.Destroy;
FClientConfig.Destroy;
FDeviceCom.Destroy;
writelog.Destroy;
FScannerJPG.Destroy;
inherited Destroy;
end;
function TdcDevice.OpenOrCloseBP(const OutData: string): integer;
var
BPDeviceMsg: TdcCfgMsgStru;
begin
FClientConfig.getConfig('B', BPDeviceMsg);
with FDeviceCom do
begin
ComPort := TComPortNumber(Ord(BPDeviceMsg.COMPort));
ComPortSpeed := TComportBaudRate(BPDeviceMsg.COMPortSpeed);
ComPortDataBits := TComPortDataBits(BPDeviceMsg.COMDataBit); //数据位
ComPortStopBits := TComPortStopBits(BPDeviceMsg.COMStopBit);
ComPortParity := TComPortParity(BPDeviceMsg.COMParity);
Disconnect;
if Connect then
begin
Result := SendData(pchar(OutData), length(OutData));
Disconnect;
if Result < 0 then
begin
Result := err_ComWrite;
end;
end //Connect End
else
begin
Result := err_ComOpen;
end;
Disconnect;
end; //end with
end;
//向串口发送数据
//输入参数 DevType-设备类型
// OutData-发送数据
//返回值 函数返回 成功返回发送长度,否则返回错误代码
function TdcDevice.sendComData(const DevType: char;
const OutData: string): integer;
begin
Result := err_Sys;
try
if DevType = 'L' then
begin //流水打印机
if ToPrn(OutData) then
begin
Result := length(OutData) //流水打印发送
end
else
begin
Result := err_Sys;
end;
end
else
if DevType = 'B' then // 2006-05-11 在连接MSU时,为了打通BP盒添加.
begin
OpenOrCloseBP(OutData);
end
else
begin
with FDeviceCom do
begin
ComPort := TComPortNumber(Ord(FDeviceMsg.COMPort));
ComPortSpeed := TComportBaudRate(FDeviceMsg.COMPortSpeed);
ComPortDataBits := TComPortDataBits(FDeviceMsg.COMDataBit); //数据位
ComPortStopBits := TComPortStopBits(FDeviceMsg.COMStopBit);
ComPortParity := TComPortParity(FDeviceMsg.COMParity);
Disconnect;
if Connect then
begin
Result := SendData(pchar(OutData), length(OutData));
writelog.writeLog('发送串口数据 :');
writelog.writeLog(OutData, Length(OutData));
Disconnect;
if Result < 0 then
begin
Result := err_ComWrite;
end;
end //Connect End
else
begin
Result := err_ComOpen;
end;
Disconnect;
end; //end with
end;
except
Result := err_Sys;
end;
end;
function TdcDevice.readComData(): integer;
var
ReadLen, tmpLen: smallint;
ReadBuf, tmpBuf: string;
t1, t2: longint;
Enter, Cancle, Close: string;
ControlMsg: TdcDevMsgStru;
f: file of Byte;
size: Longint;
DeviceCmd: pointer;
Buf: array[1..4096] of Char;
ndrvFile: file;
NumRead: integer;
begin
try
if FControlFile.isCharDrvFile then
begin
//得到文件大小
AssignFile(f, FControlFile.DrvFileName);
Reset(f);
//新添加,增加写日志
BlockRead(f, Buf, SizeOf(Buf), NumRead);
size := filesize(f);
closefile(f);
//按位置类型将drv文件内容读入内存
try
GetMem(DeviceCmd, size);
AssignFile(ndrvFile, FControlFile.DrvFileName);
Reset(ndrvFile, size);
// Read(ndrvFile, DeviceCmd^);
System.Read(ndrvFile, DeviceCmd^);
closefile(ndrvFile);
except
FreeMem(DeviceCmd, size);
exit;
end;
Enter := TKeyPadCmdA(DeviceCmd^).RDEND; {add by zcg for newland shida keypad 2006 6 1 }
Cancle := TKeyPadCmdA(DeviceCmd^).DataCancel;
Close := TKeyPadCmdA(DeviceCmd^).GREENANDREDOFF;
FreeMem(DeviceCmd, size);
end
else
begin
FControlFile.getCmd('K', 'CONTROL', 'Enter', Enter, ControlMsg);
FControlFile.getCmd('K', 'CONTROL', 'Cancle', Cancle, ControlMsg);
FControlFile.getCmd('K', 'CONTROL', 'Close', Close, ControlMsg);
end;
with FDeviceCom do
begin
ComPort := TComPortNumber(Ord(FDeviceMsg.COMPort));
ComPortSpeed := TComportBaudRate(FDeviceMsg.COMPortSpeed);
ComPortDataBits := TComPortDataBits(FDeviceMsg.COMDataBit); //数据位
ComPortStopBits := TComPortStopBits(FDeviceMsg.COMStopBit);
ComPortParity := TComPortParity(FDeviceMsg.COMParity);
OutPutTimeout := FDeviceMsg.COMTimeOut;
ReadBuf := StringOfChar(' ', 2);
Disconnect;
if Connect then
begin
t1 := GetTickCount;
t2 := 0;
while (t2 - t1) < FDeviceMsg.COMTimeOut do //---
begin //---
ReadBuf := StringOfChar(' ', 1000);
ReadLen := ReadData(ReadBuf[1], 999);
if ReadLen > 0 then
begin
if Copy(ReadBuf, 1, length(Cancle)) = Cancle then
begin
tmpBuf := '';
tmpLen := 0;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -