main.~pas

一个Delphi写的跟考勤机门禁机收款机的接品软件源码

  with dlgProgress do
  begin
    msg.Caption:=format(SOyOUAEUOAuEyYOOGeDAe, [dwMilliseconds div 1000]);
    Update;
  end;
end;

procedure TfrmMain.OnReadList(var message: TMessage);
begin
  if message.LParam=FED_NOTIFY then
  begin
    message.Result:=0;
    if Assigned(dlgHints)and(dlgHints.Visible) then
    begin
      dlgHints.msg2.Caption := format(SOyOUAXXOONIeED, [4, 0, message.WParam]);
      dlgHints.msg2.Update;
      dlgHints.Show;
      Application.ProcessMessages;
      message.Result:=1;
      if dlgHints.Tag=1 then
      begin
        frmMain.msg.Caption := SOAOGO;
        Windows.Beep(2500, 100);
        Abort;
      end;
    end;
  end;
end;

procedure TfrmMain.OnReadAllData(var message: TMessage);
var
  R: Boolean;
begin
  if message.LParam=FED_NOTIFY then
  begin
    R:=DataProgressProc(pclk, P690ReadData(message.WParam));
    if R then message.Result:=1 else message.Result:=0;
  end;
end;

function DataProgressProc(p: Pointer; lpReadData: P690ReadData): Boolean;stdcall;
var
  pclk: PClockInfo;
  card_id: string;

  procedure SaveTextLine(ReadData: T690ReadData);
  var
    Line, sYear, sMonth, sDay, sHour, sMin, sSec, sWeek: string;
    Sign_time: TDateTime;
    Correct: Boolean;

    function RecordCorrect: Boolean;
    var
      year, month, day, hour, min, sec: WORD;
    begin
      try
        year := StrToInt(sYear);
        month := StrToInt(sMonth);
        day := StrToInt(sDay);
        hour := StrToInt(sHour);
        min := StrToInt(sMin);
        sec := StrToIntDef(sSec, 0);
        sign_time:=Encodedate(year, month, day)+Encodetime(hour, min, sec, 0);
        SWeek:=IntToStr(DayOfWeek(sign_time)-1);
        Result := True;
      except
        on EConvertError do
          Result := False;
      end;
    end;
  begin
    card_id:=ReadData.CardNo;
    if (pclk.VerOrd>1) then
    begin
      if (pclk.CardLen=pclk.DispCardLen) and not (pclk.CardLen in [0, 16]) then
      begin
        if Length(card_id)>pclk.CardLen then
          card_id := Copy(card_id, Length(card_id)-pclk.CardLen+1, pclk.CardLen)
        else if (Length(card_id)<pclk.CardLen)and(StrToIntDef(card_id, -1)>=0) then
        begin
          card_id:=format('%.*u', [pclk.CardLen, StrToIntDef(card_id, 0)]);
        end;
      end;
    end;
    sYear := Copy(ReadData.TimeString, 1, 4);
    sMonth := Copy(ReadData.TimeString, 5, 2);
    sDay := Copy(ReadData.TimeString, 7, 2);
    sHour := Copy(ReadData.TimeString, 9, 2);
    sMin := Copy(ReadData.TimeString, 11, 2);
    sSec := Copy(ReadData.TimeString, 13, 2);
    if sSec='' then sSec := '00';
    Correct:=RecordCorrect;
    if Correct and frmMain.cbUseFMT.Checked then
    begin
      Line := frmMain.edFMTStr.Text;
      Line := StringReplace(Line, FDevice, IntToHex(pclk.clock_id, 2), [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FCard, card_id, [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, Ftab, #9, [rfIgnoreCase, rfReplaceAll]); //表格符
      Line := StringReplace(Line, FYear, sYear, [rfIgnoreCase, rfReplaceAll]); //四位数年份
      Line := StringReplace(Line, FYear2, Copy(sYear, 3, 2), [rfIgnoreCase, rfReplaceAll]); //两位数年份
      Line := StringReplace(Line, Fmonth, sMonth, [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FDay, sDay, [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FHour, sHour, [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FMin, sMin, [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FSec, sSec, [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FEmpId, '', [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FWeek, SWeek, [rfIgnoreCase, rfReplaceAll]);

      if GetClockSupports(pclk.hPort, fiConsumption) then
      begin
        Line := StringReplace(Line, FMark, '0', [rfIgnoreCase, rfReplaceAll]);
        Line := StringReplace(Line, FDoor, '0', [rfIgnoreCase, rfReplaceAll]);
        Line := StringReplace(Line, FFlag, IntToStr(ReadData.Flag), [rfIgnoreCase, rfReplaceAll]);
      end else
      begin
        Line := StringReplace(Line, FMark, IntToStr((ReadData.Flag and $C0) shr 6), [rfIgnoreCase, rfReplaceAll]);
        Line := StringReplace(Line, FDoor, IntToStr((ReadData.Flag and $30) shr 4+1), [rfIgnoreCase, rfReplaceAll]);
        Line := StringReplace(Line, FFlag, format('%.1u', [ReadData.Flag and $F]), [rfIgnoreCase, rfReplaceAll]);
      end;
      Line := StringReplace(Line, FTimes, format('%.3u', [ReadData.times]), [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FBalance, format('%.5u', [ReadData.balance]), [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FConsume, format('%.5u', [ReadData.consume]), [rfIgnoreCase, rfReplaceAll]);
    end
    else
    begin
      if GetClockSupports(pclk.hPort, fiConsumption) then
      begin
        Line := format('%s'#9'%14.14s'#9'%.2x'#9'%1.1u'#9'%1.1u'#9'%1.1u', [card_id, ReadData.TimeString, pclk.clock_id, 0, ReadData.Flag, 0]);
        Line := Line + format(#9'%.3u'#9'%.5u'#9'%.5u', [ReadData.times, ReadData.balance, ReadData.consume]);
      end else
      begin
        Line := format('%s'#9'%14.14s'#9'%.2x'#9'%1.1u'#9'%1.1u'#9'%1.1u', [card_id, ReadData.TimeString, pclk.clock_id, (ReadData.Flag and $C0) shr 6, ReadData.Flag and $7, (ReadData.Flag and $30) shr 4+1]);
        Line := Line + format(#9'%.3u'#9'%.5u'#9'%.5u', [ReadData.times, ReadData.balance, ReadData.consume]);
      end;
    end;
    Line:=Line+#9+ReadData.Clock_ver+#9+inttostr(ReadData.Clock_ID)+#9+inttostr(ReadData.POS_Sequ)+#9+inttostr(ReadData.Card_Sequ)+#9+ReadData.Op_CardNo ;    
    if Correct then
    begin
      WriteLn(F, Line);
    end else
    begin
      WriteLn(F2, Line);
    end;
  end;

begin
  Result:=False;
  pclk:=p;
  if Assigned(lpReadData)and Assigned(pclk) then
  with PClockInfo(pclk)^ do
  begin
    dlgProgress.bCancel:=False;
    if lpReadData.Record_Index mod 10=1 then
      Application.ProcessMessages;
    dlgProgress.ProgressBar.Min:=0;
    dlgProgress.ProgressBar.Max:=lpReadData.Record_total;
    dlgProgress.ProgressBar.Position:=lpReadData.Record_index;
    dlgProgress.msg.Caption:=format(SOyOUAEUDDIoCA, [lpReadData.Record_index, lpReadData.Record_total]);
    if not lpReadData.Verify_Error then
      SaveTextLine(lpReadData^)
    else
    begin
      if (MsgBox(dlgProgress.Handle, PChar(SCAGNeIIoECNAE), msg_error, MB_YESNO or MB_ICONERROR)=IDYES) then
        SaveTextLine(lpReadData^);
      if (MsgBox(dlgProgress.Handle, PChar(SECNIGOEO), msg_error, MB_YESNO or MB_ICONERROR)=IDYES) then
        lpReadData.Verify_Error:=False;
    end;
    if lpReadData.Verify_Error or
      (dlgProgress.bCancel and (MsgBox(dlgProgress.Handle, PChar(SAuEEOOGOEyYOEOAg), msg_confirm, MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2)=IDYES)) then
    begin
      Result:=False;
      lpReadData.Verify_Error:=True;
      dlgProgress.bCanClose:=True;
    end else
      Result:=True;
  end;
end;

function ListSortCompare(Item1, Item2: Pointer): Integer;
begin
  Result := 0;
  if Assigned(Item1)and Assigned(Item2) then
  begin
    if FDeviceSortIndex+1<=High(PCardList(Item1)^.Cols) then
    begin
      if FDeviceSortAsc then
        Result:=CompareText(PCardList(Item1)^.Cols[FDeviceSortIndex+1], PCardList(Item2)^.Cols[FDeviceSortIndex+1])
      else
        Result:=CompareText(PCardList(Item2)^.Cols[FDeviceSortIndex+1], PCardList(Item1)^.Cols[FDeviceSortIndex+1]);
    end;
  end;
end;

procedure TfrmMain.ListViewData(Sender: TObject; Item: TListItem; List: TList);
var
  i: Integer;
begin
  if Item.Index>List.Count then Exit;
  with PCardList(List[Item.Index])^ do
  begin
    Item.Data := List[Item.Index];
    Item.Caption := Cols[1];
    for i:=2 to High(Cols) do
      Item.SubItems.Add(Cols[i]);
  end;
end;

procedure TfrmMain.OnActiveFormChange(Sender: TObject);
begin
  if Assigned(Screen.ActiveForm) then
  with TControlAccess(Screen.ActiveForm) do
  begin
//    DesktopFont:=True;
  end;
end;

procedure TfrmMain.ListViewDataFind(Sender: TObject; Find: TItemFind;
  const FindString: string; const FindPosition: TPoint; FindData: Pointer;
  StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
  var Index: Integer; List: TList);
var
  I: Integer;
  Found: Boolean;
begin
  I := StartIndex;
  if List.Count>0 then
    if (Find=ifExactString)or(Find=ifPartialString) then
    begin
      repeat
        if (I>List.Count-1) then
          if Wrap then
            I := 0
          else
            Exit;
        if Find=ifExactString then
          Found := UpperCase(FindString)=UpperCase(PCardList(List[i])^.Cols[1])
        else
          Found := Pos(UpperCase(FindString), UpperCase(PCardList(List[i])^.Cols[1]))=1;
        Inc(I);
      until Found or(I=StartIndex);
      if Found then
        Index := I-1;
    end;
end;

function TfrmMain.GetStoredFileName(pclk: PClockInfo): string;
var
  S: string;
  clock_id: Byte;
begin
  if DirectoryExists(edFileName.Text) then
  begin
    Dir := edFileName.Text;
  end
  else if edFileName.Text<>'' then
  begin
    Dir := ExtractFileDir(edFileName.Text);
    if Dir='' then
      Dir := GetCurrentDir;
    S := ExtractFileName(edFileName.Text);
  end
  else if edFileName.Text='' then
  begin
    Dir := GetCurrentDir;
  end;
  case rbSave.ItemIndex of
    0:{每天一个文件}
      begin
        if S='' then S:=Format('%s.txt', [FormatDateTime('yyyyMMdd', Date)]);
        FileName := IncludeTrailingBackslash(Dir)+S;
      end;
    1:{每次生成一个新文件}
      begin
        if S='' then S:=Format('%s.txt', [FormatDateTime('yyyyMMdd', Date)]);
        FileName := IncludeTrailingBackslash(Dir)+S;
        FileName := GetFileName(FileName);
      end;
    2:{每台设备一个文件}
      begin
        if Assigned(pclk) then clock_id:=pclk.clock_id else clock_id:=01;
        if S='' then
        begin
          FileName:=IncludeTrailingBackslash(Dir)+format('%s-%.2x.txt', [FormatDateTime('yyyyMMdd', Date), clock_id]);
        end else
          FileName := IncludeTrailingBackslash(Dir)+S;
      end;
    end;
  Result := FileName;
end;

procedure TfrmMain.ChooseDev;
begin
  PageControl1.ActivePage := tsClockList;
  MsgBox(Screen.ActiveForm.Handle, PChar(SCeNOnUAE), PChar(SIaE), MB_OK);
  Abort;
end;

function TfrmMain.GetFileName(FileName: string): string;
var
  Ext, F, S: string;
  i: Word;
begin
  Ext := ExtractFileExt(FileName);
  F := Copy(FileName, 1, Pos(Ext, FileName)-1);
  i := 1;
  S := F+Ext;
  if FileExists(S) then
    while true do
    begin
      S := F+IntToStr(i)+Ext;
      if not FileExists(S) then
        break;
      inc(i);
    end;
  Result := S;
end;

procedure TfrmMain.ClosePort(pclk: PClockInfo);
begin
  if Assigned(pclk) then
  begin
    if (pclk.hPort<>0)and(pclk.hPort<>INVALID_HANDLE_VALUE) then
      EastRiver.DisConnectClock(pclk.hPort);
    pclk.hPort := 0;
    pclk.Connected:=False;
    edInspector.Caption := SINU;
  end;
end;

function TfrmMain.OpenPort(pclk: PClockInfo): Boolean;
var
  i: Integer;
  R: Boolean;
  SaveCursor: TCursor;
begin
  Result:=False;
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  try
    msg.Caption := Format(SOyOUAOSS, [pclk.Port, pclk.clock_id]);
    msg.Update;
    if not CheckHandle(pclk.hPort) then
    begin
      pclk.Connected := False;
      pclk.hPort := OpenCommPort(pclk.Port, pclk.BaudRate);
      if CheckHandle(pclk.hPort) then
      begin
        if pclk.clock_type<>0 then
          SetClockModel(pclk.hPort, pclk.Model, pclk.Fireware, pclk.cls)
        else
        begin
          SetCmdVerify(cbCmdVerifyFirst.Checked);
        end;
        if not CallClock(pclk.hPort, pclk.clock_id) then
        begin
          CloseHandle(pclk.hPort);
          pclk.hPort:=0;
          Result:=False;
        end else
        begin
          Result:=True;
        end;
      end;
      if Result and CheckHandle(pclk.hPort) then
      begin
        SetCardStyle(cbCardStyle.ItemIndex);
        edInspector.Caption := SAU;
        msg.Caption := SAOE;
        if pclk.clock_type<>0 then
        begin
          SetClockModel(pclk.hPort, pclk.Model, pclk.Fireware, pclk.cls);//自动识别
          pclk.VerOrd:=GetClockVersionOrd(pclk.hPort);
//          SetCmdVerify(pclk.CmdVerify);
        end else
        begin
          GetClockModel(pclk.hPort, pclk.Model, pclk.Fireware, pclk.cls);
          pclk.VerOrd:=GetClockVersionOrd(pclk.hPort);
        end;
      end
      else if pclk.hPort=INVALID_HANDLE_VALUE then//端口无效或正在使用
      begin
        Result:=False;
        pclk.hPort := 0;
        edInspector.Caption := SINU;