⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 device.pas

📁 控制扫描仪的DELPHI源码,本人最得意的地方是可以双面打印哦
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -