unit_global_variant.~pas

a program written by delphi about middle layer

    end;
  end;
  if CardReader_class =1 then
  begin
    Result := 0;
    fn_SetKey;
    //寻卡
    iRun := rfReader_Select(hDev, 0, 4, 0, @pDataType);
    if iRun<>4 then
    begin
      Result := iRun;
      exit;
    end;

    for i:=1 to 16 do pDataType[i] := 0;
    iRun := rfReader_M1_Read(hDev, 0, 0, iBlock, @M1CardKey, @pDataType);
    if iRun=16 then
    begin
      for i:=1 to 16 do
        sDataType := sDataType + char(pDataType[i]);
      if      sDataType='PKU-DIGICAREJKHY' then  Result := 1    //会员卡
      else if sDataType='PKU-DIGICAREJKLC' then  Result := 2    //流程卡
      else                                       Result := -99;
    end
    else
      Result := iRun-1;
  end;
end;

//读卡数据
function fn_iReadData(hDev:integer;out sData: string): integer;
var
  iRun, i, iBlock: integer;
  pData: array[1..16] of Byte;
  st : smallint;
  snr:longint;
  databuff:Array[1..32]of Char;
begin
  sData := '';
  iBlock := 2; //存放数据的内容
  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
      begin
        if UpperCase(databuff[i])='F' then
          sData := sData + ''
        else
          sData := sData + databuff[i];
      end;
      sData := Trim(HexToStr(sData));
      Result := 0;
    end;
  end;

  if CardReader_class =1 then
  begin
    Result := 0;
    fn_SetKey;
    //寻卡
    iRun := rfReader_Select(hDev, 0, 4, 0, @pData);
    if iRun<>4 then
    begin
      Result := iRun;
      exit;
    end;

    for i:=1 to 16 do pData[i] := 0;
    iRun := rfReader_M1_Read(hDev, 0, 0, iBlock, @M1CardKey, @pData);
    if iRun=16 then
      for i:=1 to 16 do
      begin
        if pData[i]=255 then
          sData := sData + ''
        else
          sData := sData + char(pData[i]);
      end
    else
      Result := iRun-1;
  end;
end;
//----------------------------------------------------------------
function HexToStr(sHex: String): String;
var
  i: integer;
  sData: String;
begin
  sData := '';
  for i:=0 to (Length(sHex) div 2 -1) do
    sData := sData + Char(StrToInt('0x'+Copy(sHex, i*2+1, 2)));
  Result := sData;
end;

function StrToHex(sData: String): String;
var
  i: integer;
  sHex: String;
begin
  sHex := '';
  for i:=1 to Length(sData) do
    sHex := sHex + IntToHex(Byte(sData[i]),2);
  Result := sHex;
end;


//*******************************************************
//公共扩展函数，clf提供

function GetDelimitStr(sData, sDelimiter: String; iSeqNo: Integer): String;
var
  i, iStrLen, iPos, iDelLen: integer;
begin
  iStrLen := Length(sData);
  iDelLen := Length(sDelimiter);
  for i:=1 to iSeqNo do
  begin
    iPos := Pos(sDelimiter, sData);
    if iPos<>0 then sData := Copy(sData, iPos+iDelLen, iStrLen)
    else sData := '';
  end;
  iPos := Pos(sDelimiter, sData);
  if iPos<>0 then Result := Copy(sData, 1, iPos-1)
  else Result := sData;
end;

//窗口闪动提示信息
procedure flashsubwindows(handle:hwnd);
var
  i,c:integer;
  b_flash:boolean;
begin
   i:=800;
   for c:=0 to i do
   begin
      if c mod 23 <> 0 then
      begin
        b_flash:=true ;
        flashwindow(handle,b_flash);
      end else
      begin
        b_flash:=false;
        flashwindow(handle,b_flash);
      end
   end;
end;

// clf 2001-4-12 add
function GetInputNames: TStringList;
var
  Reg: TRegistry;
  Val1, Val2: TStringList;
  i, j: integer;
begin

  Reg := TRegistry.Create;
  Val1 := TStringList.Create;
  Val2 := TStringList.Create;
  Result := TStringList.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\System\CurrentControlSet\Control\Keyboard Layouts', True) then
    begin
      Reg.GetKeyNames(Val1);
      for i := 0 to Val1.Count - 1 do
      begin
      if Reg.OpenKey('\System\CurrentControlSet\Control\Keyboard Layouts\'
                     + Val1[i], True) then
      begin
         Reg.GetValueNames(Val2);
         for j:=0 to Val2.Count -1 do
         if UpperCase(Val2[j]) = 'IME FILE' then
            Result.Add(Reg.ReadString('Layout Text'));
      end;
      end;
    end;
  finally
    Reg.CloseKey;
    Reg.Free;
    Val1.Free;
    Val2.Free;
  end;
end;



//查找并修改表中两个所有字段
function  find_edit_record_fk(var cds1:tclientdataset;field1,field2,field3,s1,s2,s3:string):boolean;
begin
   result:=false;
   if cds1.RecordCount >0  then
   begin
      cds1.DisableControls;
      cds1.First ;
      while not cds1.Eof  do
      begin
         if trim(cds1.fieldbyname(field1).value)=s1 then
         begin
            cds1.edit;
            cds1.FieldByName(field2).value:=s2;
            cds1.FieldByName(field3).value:=s3;
            cds1.post;
            result:=true;
         end ;
         cds1.Next ;
      end;
      cds1.EnableControls ;
   end;
end;

//修改整个表记录
procedure  edit_record_dept(var cds:tclientdataset;field1,s1:string);
begin
   if cds.RecordCount >0 then
   begin
      cds.DisableControls;
      cds.First ;
      while not cds.Eof  do
      begin
         cds.edit;
         cds.FieldByName(field1).value:=s1;
         cds.post;
         cds.Next ;
      end;
      cds.EnableControls ;
   end;
end;
//查看表中同一列是否有相同值
function find_record_dept(var cds:tclientdataset;field:string):boolean;
var find:string;
begin
   result:=false;
   find:='';
   if cds.RecordCount >0 then
   begin
      cds.First ;
      find:=vartostr(cds.fieldbyname(field).value);
      cds.DisableControls ;
      cds.First ;
      while not cds.Eof  do
      begin
        if find<> cds.FieldByName(field).value then
        result:=true;
        break;
        cds.Next ;
      end;
      cds.EnableControls ;
   end;
end;
//找到表中字段后修改其中一个字段  (cds1)
procedure  find_edit_record(var cds1,cds2:tclientdataset;
  field1,field2,field3,s1,s2:string);
begin
   if (cds1.RecordCount >0)and(cds2.RecordCount>0)  then
   begin
      cds1.DisableControls;
      cds1.First ;
      while not cds1.Eof  do
      begin
         if cds1.fieldbyname(field1).value=cds2.fieldbyname(field1).value then
         begin
            cds1.edit;
            cds1.FieldByName(field2).value:=s1;
            cds1.FieldByName(field3).value:=s2;
            cds1.post;
         end;
         cds1.Next ;
      end;
      cds1.EnableControls ;
   end;
end;
//修改整个表记录
procedure edit_record(var cds:tclientdataset;field1,field2,s1,s2:string);
begin
   if cds.RecordCount >0 then
   begin
     cds.DisableControls;
     cds.First ;
     while not cds.Eof  do
     begin
       cds.edit;
       cds.FieldByName(field1).value:=s1;
       cds.FieldByName(field2).value :=s2;
       cds.post;
       cds.Next ;
     end;
     cds.EnableControls ;
   end;
end;
//查找表中所有记录
function find_record(var cds:tclientdataset;field,s:string):boolean;
begin
   result:=false;
   if cds.RecordCount >0 then
   begin
     cds.DisableControls ;
     cds.First ;
     while not cds.Eof  do
     begin
       if cds.FieldByName(field).value=s then
       result:=true;
       cds.Next ;
     end;
     cds.EnableControls ;
   end;
end;

//统计表中所有字段值
function sum(var cds:tclientdataset;s:string):double;
begin
   result:=0;
   if cds.RecordCount>0 then
   begin
      cds.First;
      while not cds.Eof do
      begin
        if not cds.FieldByName(s).isnull then
        result:=result+cds.fieldbyname(s).value;
        cds.Next ;
      end;
   end;
end;

//拷贝相同两个表记录
procedure copytable(var cds1,cds2:tclientdataset);
var i:integer;
begin
  cds2.Insert;
  if cds1.RecordCount>0 then
  begin
     for i:=0 to cds1.FieldCount-1 do
     begin
       cds2.Edit;
       cds2.Fields[i].value:=cds1.Fields[i].value;
       cds2.post;
     end;
  end;
end;

Function NBGetAdapterAddress(ino:Integer) : String;
Var

  NCB : TNCB; // Netbios control block //NetBios控制块
  ADAPTER : TADAPTERSTATUS; // Netbios adapter status//取网卡状态
  LANAENUM : TLANAENUM; // Netbios lana
  intIdx : Integer; // Temporary work value//临时变量
  cRC : Char; // Netbios return code//NetBios返回值
  strTemp : String; // Temporary string//临时变量

Begin
  // Initialize
  Result := '';

  Try
    // Zero control blocl
    ZeroMemory(@NCB, SizeOf(NCB));

    // Issue enum command
    NCB.ncb_command := Chr(NCBENUM);
//    cRC := NetBios(@NCB);

    // Reissue enum command
    NCB.ncb_buffer := @LANAENUM;
    NCB.ncb_length := SizeOf(LANAENUM);
    cRC := NetBios(@NCB);
    If Ord(cRC)<>0 Then
      exit;

    // Reset adapter
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_command := Chr(NCBRESET);
    NCB.ncb_lana_num := LANAENUM.lana[ino];
    cRC := NetBios(@NCB);
    If Ord(cRC)<>0 Then
      exit;

    // Get adapter address
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_command := Chr(NCBASTAT);
    NCB.ncb_lana_num := LANAENUM.lana[ino];
    StrPCopy(NCB.ncb_callname, '*');
    NCB.ncb_buffer := @ADAPTER;
    NCB.ncb_length := SizeOf(ADAPTER);
//    cRC := NetBios(@NCB);

    // Convert it to string
    strTemp := '';
    For intIdx := 0 To 5 Do
      strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]),2);
    Result := strTemp;
  Finally
  End;
End;

function TrancCurrentNo(iNum: Integer):String;
var
  sTempStr:String;
  i: Integer;
begin
  sTempStr := '0000000000';