unit_global_variant.~pas

a program written by delphi about middle layer

unit Unit_global_variant;

interface
uses
  Windows, Messages, SysUtils,MConnect, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,Db,DbClient,DsnUnit, DsnSubMl, DsnSubGr, DsnSubDp,Registry, DBGridEh, DBCGrids,
  QuickRpt, Qrctrls, QRExpbld, TypInfo, ActnList, NB30, Variants, ComCtrls, StrUtils, MdDictEdit,
  MdDictDBEdit, StdCtrls, DBGrids, Grids,DBCtrls,spcomm ,IniFiles; //ActnList,NB30 后加

type
      Trec_Report_data = record
      report_code : Integer;
      report_sql  : String;
      short_name  :string; //后加
      report_flag :   string;
end;

//2007.2.2 by nls 增加改变dbgrid的选中时的颜色
type
   TEventHandlers = class
    procedure dbGridEhDrawColumnCell(Sender: TObject;
        const Rect: TRect; DataCol: Integer; Column: TColumnEh;
        State: TGridDrawState); overload;
    procedure dbGridEhDrawColumnCell(Sender: TObject;
        const Rect: TRect; DataCol: Integer; Column: TColumn;
        State: TGridDrawState); overload;
    procedure DBGridEhTitleClick(Sender: TObject; ACol: Integer; Column: TColumnEh);
  private
end;


const

  //SelectMessageBox参数定义说明.
  FLAG_INFO = 1;         { selectmessagebox的CaptionNum为‘提示’
                           对话窗标题为：提示，ICON为：惊叹号     {}
  FLAG_ERROR = 2;        { selectmessagebox的CaptionNum为‘错误’
                           对话窗标题为：错误，ICON为：叉号       {}
  BUTTON_OK = 1;         {selectmessagebox的Flags为MB_OK
                             对话窗将显示按钮一个：确定           {}
  BUTTON_OKCANCEL = 2;   {selectmessagebox的Flags为MB_OKCANCEL
                             对话窗将显示按钮两个：确定、取消     {}
  BUTTON_YESNO = 3;      {selectmessagebox的Flags为MB_YESNO
                               对话窗将显示按钮两个：是、否       {}

  cl_enabled = clWhite;       //可编辑状态
  cl_disabled = $00E0F4F5;    //不可编辑状态 $00FFF0F0;

  cl_dbGridFixed = $00F0C0C0;    //DBGrid标题栏颜色     00F5EFEB
  cl_dbGrid = $00E0F4F5;         //DBGrid的颜色         clCream

  cl_dbSelColor = $00B5E9FF;     //DBGrid中cell选中时的背景颜色


  //copy from lis, 2006.10.20, by nls
  WM_REFRESHSAMPLE = WM_USER + 1;  //SampCenterDM通知SampCenter窗口刷新显示
  WM_CLOSEREPORTWIN = WM_USER + 10;//通知frmMainBase通用报表窗口关闭
  WM_REPLACERESULT = WM_USER + 20; //自由标本窗口通知主窗口替换结果
  WM_DELETESAMPLE = WM_USER + 30;  //自由标本窗口删除了一个标本
  WM_SAMPLEADDED = WM_USER + 40;
  WM_SAMPLECHANGE = WM_USER + 50;  //批量确认后需要刷新标本列表
  WM_GRIDCELLCLICK = WM_USER + 60; //排检窗体和预订窗体

  WM_CLOSECHILDWINDOW = WM_USER + 100; //子窗体关闭
  
  CardReader_class = 2 ;//1：北京天一公司；2：明华公司公司

Var
  gv_login_appserver:string; //读取INI文件登录服务器名称 add0818time
  pDeptCode,pUserMi,pUserName,pEmpName: PChar;
  rec_Report_data: Trec_Report_data;
 // gv_login_appserver:  string;
  gv_aclmain:      TActionList;
  gv_pc_id:        string; //应用程序启动时读取网卡号
  gv_user_mi:      String; //工号        登入后赋值
  gv_user_name:    String; //登录名
  //***
  gv_emp_name:     String;//用户真实名称
  //***
  gv_subsys_id:    String; //从chis.ini中取子系统id
  gv_subsys_name:  String;
  gv_hospital:     String;
  gv_dept_code:    String;
  gv_ward_code:    String;
  gv_group_no:     String;
  gv_Input_Method: string; //从chis.ini中取得输入法 clf 2001-4-13 add
  gv_window_no:    String; //从chis.ini中取得窗口号
  gv_AppServer:    String; //从chis.ini中取应用服务器名
  gv_database:     string; //从chis.ini中取数据库名
  gv_menu:         String; //从chis.ini中
  gv_toolbar1:     String; //从chis.ini中
  gv_toolbar2:     String; //从chis.ini中
  gv_helpfile:     String; //从chis.ini中取帮助文件
  gv_station_name: String;

  gv_com_no:       String; //读卡器连接串口号
  gv_pdf_printer:  String; //pdf虚拟打印机名称   从chis.ini中取
  gv_App_Dir:      String; //主程序的所在的目录
  gv_debug:        String; //是否属于调试状态
  //中间层服务器名称
  MiddleServerName: string;
  //安装目录
  sInstallDirectory: string;

  gv_repeated_subject_charge_flag :string;

  gv_node_no :string;  //fjp

  gv_checktype_no : String;  //fjp

  gv_register_unit_flag : String; //fjp

  //gv_overall_checktype_code : String; //fjp

  gv_blood_sample_code :String; //fjp

  gv_lis_dept_code : String; //fjp

  gv_section_no : String; //fjp

  gv_general_dept_code :String; //fjp

  gv_operation_code : String; //fjp,检室操作者编码

  gv_overall_dept_code :String; //fjp

  gv_restaurant_dept_code :String; //fjp

  gv_inquiry_dept_code :String; //fjp

  gv_vip_dept_flag : String; //fjp,贵宾室标识

  gv_need_checkout_flag : String; //fjp,刷出疹间是否需要再次刷卡

  gv_flow_node_flag : String; //fjp,流程节点标识,0：操作站别；1：流程节点

  gv_auto_open_node : String; //需自动打开的总检诊间

  gv_auto_open_flag : String; //总检被自动打开标识

  gv_intertrans_flag : String; //传输接口函数标识

  gv_pre_checktype_no : String; // 预先排入的科室编码

  //report, by nls
  gv_print_device: string; //0-预览; 1-打印
  gv_print_mode:   integer;//0-普通; 1-线程打印

  M1CardKey: array[1..6] of Byte;

  nkey : Pchar;

  tComOuter, tComInner : TComm;
  bsDelay_out, bsAddr_out, bsActlen_out, bsIn_out, bsOut_out, bsStop_out : integer;
  bsDelay_in, bsAddr_in, bsActlen_in, bsIn_in, bsOut_in, bsStop_in : integer;

  gv_led_out,gv_led_in : String;
  gv_led_node,gv_led_welcome,gv_led_checkin,gv_led_wait : String;
  gv_led_caption,gv_led_caption_inner : String;

  //2007.2.2 by nls 增加改变dbgrid的选中时的颜色
  EvHandler:TEventHandlers;

  procedure flashsubwindows(handle:hwnd);
  function  find_edit_record_fk(var cds1:tclientdataset;
    field1,field2,field3,s1,s2,s3:string):boolean;
  procedure edit_record_dept(var cds:tclientdataset;
    field1,s1:string);
  function find_record_dept(var cds:tclientdataset;
    field:string):boolean;
  procedure  find_edit_record(var cds1,cds2:tclientdataset;
    field1,field2,field3,s1,s2:string);
  procedure edit_record(var cds:tclientdataset;
    field1,field2,s1,s2:string);
  procedure copytable(var cds1,cds2:tclientdataset);
  function find_record(var cds:tclientdataset;
    field,s:string):boolean;
  function sum(var cds:tclientdataset;s:string):double;
  //clf 2001-4-12 add
  function GetInputNames: TStringList;
  //*************************************
  Function NBGetAdapterAddress(ino:Integer) : String;//得到地址
  procedure query_openwindow(mainform:tform;appserver,subsysid,userid,setflag0:pchar);
  function SelectMessageBox(Text:string; CaptionNum: integer; Flags: integer): Integer;
  Function _AddAllFields(DestClientDataSet: TClientDataSet):Boolean;
  procedure ShowLineedt(stgReport:TDsnStage;iRepControlsNum:integer) ;
  procedure HideLineedt(stgReport:TDsnStage;iRepControlsNum:integer) ;
  function ConvertDigit(iDigital:Double): String;
  function UpperDigit(iDigit:integer):string;
  function DigitDW(iDW:integer):string;
  function TrancCurrentNo(iNum: Integer):String;
  function GetMac:string;
  procedure InitPageControl(pcTemp: TPageControl);
  procedure ChangeState(owner:TWinConTrol;enabled:Boolean; cl:TColor);  //fjp
  function HexToStr(sHex: String): String;
  function StrToHex(sData: String): String;
  function GetChineseParamStr(sName: string):string; //中文参数加空格
  function  fn_iOpenCom(pCom: pChar): Integer;
  function  fn_iCloseCom(hDev: Integer): Integer;
  function  fn_iReadCardID(hDev:integer;out sID: string): integer;
  function  fn_iReadDataType(hDev:integer): integer;
  function  fn_iReadData(hDev:integer;out sData: string): integer;
  function  fn_sGetError(iError: integer): String;
  procedure fn_SetKey;

  procedure SetInterfaceStyle(pForm: TForm);          //设置界面风格  2007.1.16 在FormCreate中调用
  procedure SetDictGridStyle(pDE: TMdDictEdit); overload;       //设置DictEdit的下拉Grid
  procedure SetDictGridStyle(pDE: TMdDictDbEdit); overload;
  procedure dbGridEhDrawSelectedCellColor(dbg: TDBGridEh; State: TGridDrawState);  //2007.2.2 by nlsh 设置DBGrid中选中项目的颜色.

  //使用方法：如果是单列不排序，设定其tag为97，如果是整个Grid不排序，可以在OnTitleBtnClick中写一个无效的事件.
  procedure OrderGrid(dataSet:TClientDataset;orderField:string);  //设置DBgridEh根据标题排序 2007.2.26 by nls

  procedure AlignFormCenter(frm: TForm);    //设定窗口显示在屏幕中央 2007.4.30 by nlsh
//************************************************
//外部调用函数声明
//************************************************
  function  Login(sAppserver,sSubSys_id,
                 sDescName,sHospitalName: Pchar; var sEmpCode,sDeptCode,sEmpName,sUserName:Pchar) : boolean;
            external 'dll_login.dll';


  procedure OpenUserManage(MainForm : TForm; Appserver,Subsys_id:Pchar ;aclMain : TActionList);
             external 'dll_user_manage.dll';

  //读卡_北京天一集成科技有限公司
  function  rfReader_Open(pCom: pChar;iBaud:integer=9600): Integer;stdcall;external 'MifareOne.dll';
  function  rfReader_Close(hDev: Integer): Integer; stdcall;external 'MifareOne.dll';
  function  rfReader_select(hDev: Integer; icdev: word;srcLen,model:Byte; pSnr: Pointer): Integer;stdcall; external 'MifareOne.dll';
  function  rfReader_M1_read(hDev: Integer;icdev: word;KeyA_B,block: Byte; key: Pointer; pData: Pointer): Integer;stdcall;external 'MifareOne.dll';
  function  rfReader_M1_write(hDev: Integer;icdev: word;KeyA_B,block: Byte; key: Pointer; pData: Pointer): Integer;stdcall;external 'MifareOne.dll';

  //读卡_明华公司
  function rf_init(port: smallint;baud:longint): longint; stdcall;
  far;external 'mwrf32.dll' name 'rf_init';
  function rf_exit(icdev: longint):smallint;stdcall;
  far;external 'mwrf32.dll'name 'rf_exit';
  function rf_card(icdev:longint;mode:smallint;snr:pChar):smallint;stdcall;
  far;external 'mwrf32.dll'name 'rf_card';
  function rf_load_key(icdev:longint;mode,secnr:smallint;nkey:pchar):smallint;stdcall;
  far;external 'mwrf32.dll' name 'rf_load_key';
  function rf_load_key_hex(icdev:longint;mode,secnr:smallint;nkey:pchar):smallint;stdcall;
  far;external 'mwrf32.dll' name 'rf_load_key_hex';
  function rf_authentication(icdev:longint;mode,secnr:smallint):smallint;stdcall;
  far;external 'mwrf32.dll' name 'rf_authentication';
  function rf_read(icdev:longint;adr:smallint;data:pchar):smallint;stdcall;
  far;external 'mwrf32.dll' name 'rf_read';
  function rf_read_hex(icdev:longint;adr:smallint;data:pchar):smallint;stdcall;
  far;external 'mwrf32.dll' name 'rf_read_hex';
  function rf_write(icdev:longint;adr:smallint;data:pchar):smallint;stdcall;
  far;external 'mwrf32.dll' name 'rf_write';
  function rf_write_hex(icdev:longint;adr:smallint;data:pchar):smallint;stdcall;
  far;external 'mwrf32.dll' name 'rf_write_hex';
  function rf_halt(icdev:longint):smallint;stdcall;
  far;external 'mwrf32.dll' name 'rf_halt';
  function rf_reset(icdev:longint;msec:smallint):smallint;stdcall;
  far;external 'mwrf32.dll' name 'rf_reset';

//************************************************
  function  GetDelimitStr(sData, sDelimiter: String; iSeqNo: Integer): String;

  procedure bsStartComm(sType: string);      //sType = outer, inner
  procedure bsCloseComm(sType: string);      //sType = outer, inner
  procedure bsSendToLED(sData: string; sType: string;comm1:TComm); //sData: 显示数据
  procedure SendToLED(str: string;actlen,addr: Byte;delayTime:integer;
      sty_in: integer;sty_out:integer;sty_stop:integer;comm1:TComm);

  function getLedName(sName:String):string;

  function creTimeStr(iSec:integer):string; //由秒生成以分钟+秒钟形式来显示的字符串

implementation

//------------------------------读M1卡---------------------------
function fn_sGetError(iError: integer): String;
begin
  case iError of
    -1:  Result := '打开串口失败!';
    -2:  Result := '读取失败';
    -11: Result := '读卡器连接错!';
    -12: Result := '没有执行打开串口函数!';
    -99: Result := '非本系统卡!';

    -100: Result := '无卡';
    -200: Result :='CRC校验错';
    -300: Result :='值溢出';
    -400: Result :='未验证密码';
    -500: Result := '奇偶校验错';
    -600: Result :='通讯出错';
    -800: Result :='错误的序列号';
    -1000: Result :='验证密码失败';
    -1100: Result :='接收的数据位错误';
    -1200: Result :='接收的数据字节错误';
    -1400: Result :='Transfer错误';
    -1500: Result :='写失败';
    -1600: Result :='加值失败';
    -1700: Result :='减值失败';
    -1800: Result :='读失败';
    -16: Result := 'PC与读写器通讯错误';
    -17: Result := '通讯超时';
    -32: Result := '打开通信口失败';
    -36: Result := '串口已被占用';
    -48: Result :='地址格式错误';
    -49: Result :='该块数据不是值格式';
    -50: Result :='长度错误';
    -64: Result :='值操作失败';
    -80: Result :='卡中的值不够减';
    else Result := '未知错误!';
  end;
end;

procedure fn_SetKey;
begin
  if CardReader_class =1 then
  begin
    M1CardKey[1] := $FF;
    M1CardKey[2] := $FF;
    M1CardKey[3] := $FF;
    M1CardKey[4] := $FF;
    M1CardKey[5] := $FF;
    M1CardKey[6] := $FF;
  end;
  if CardReader_class =2 then
    nkey:='FFFFFFFFFFFF'; 
end;

function  fn_iOpenCom(pCom: pChar): Integer;
begin
  if CardReader_class =1 then
    Result := rfReader_Open( pChar('COM'+gv_com_no) );
  if CardReader_class =2 then
    Result := rf_init(strtoint(gv_com_no),9600);
end;

function  fn_iCloseCom(hDev: Integer): Integer;
begin
  if CardReader_class =1 then
    Result := rfReader_Close( hDev );
  if CardReader_class =2 then
  begin
    if hDev > 0 then
      Result := rf_exit( hDev );
  end;
end;

//读序列号
function fn_iReadCardID(hDev:integer;out sID: string): integer;
var
  iRun, i: integer;
  pID: array[1..4] of Byte;
  snr:longint;
  st : smallint;
begin
  sID := '';
  if CardReader_class =1 then
  begin
    Result := 0;
    for i:=1 to 4 do pID[i] := 0;

    iRun := rfReader_Select(hDev, 0, 4, 0, @pID);
    if iRun=4 then
      for i:=1 to 4 do sID := sID + IntToHex(pID[i],2)
    else
      Result := iRun-1;
  end;
  if CardReader_class =2 then
  begin
    st:=rf_card(hDev,1,@snr);
    if st > 0 then
      Result := -(st*100)
    else
      Result := st;
    sID := inttohex(snr, 8);
  end;
end;

//读卡类别
function fn_iReadDataType(hDev: integer): integer;
//返回：1。会员卡 2。流程卡
var
  iRun, i, iBlock: integer;
  pDataType: array[1..16] of Byte;
  sDataType: string;
  st : smallint;
  snr:longint;
  databuff:Array[1..32]of Char;
begin
  sDataType := '';
  iBlock := 1; //存放卡类型
  if CardReader_class =2 then
  begin
    //寻卡
    st:=rf_card(hDev,1,@snr);

    if st<>0 then //寻卡失败
    begin
      if st > 0 then
        Result := -(st*100)
      else
        Result := st;
      exit;
    end;
    //设置密码
    fn_SetKey;
    st:=rf_load_key_hex(hDev,0,0,nkey);
    if st<>0 then
    begin
      if st > 0 then
        Result := -(st*100)
      else
        Result := st;
      exit;
    end;
    //验证
    st:=rf_authentication(hDev,0,0);
    if st<>0 then
    begin
      if st > 0 then
        Result := -(st*100)
      else
        Result := st;
      exit;
    end;
    st:=rf_read_hex(hDev,iBlock,@databuff);
    if st<>0 then
    begin
      if st > 0 then
        Result := -(st*100)
      else
        Result := st;
    end
    else
    begin
      //for i:=1 to 32 do
      //  sDataType := sDataType + databuff[i];
      sDataType := HexToStr(databuff);
      if      sDataType='PKU-DIGICAREJKHY' then  Result := 1    //会员卡
      else if sDataType='PKU-DIGICAREJKLC' then  Result := 2    //流程卡
      else                                       Result := -99;