main.~pas

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

      if dlgCardNo.Execute then
      begin
        CardNo := Trim(dlgCardNo.edCardNo.Text);
        Right := False;
        if pclk.VerOrd>1 then
          Right := SetManagerCard(pclk.hPort, PChar(CardNo))
        else if MsgBox(Handle, pchar(format(SCeEOUCOMDEUEIOAOOGOIEeNOoEuOGEeAAIIaIAUIAECNIGEeOAUI, [pclk.Port])), msg_confirm, MB_YESNO or
          MB_ICONQUESTION)=IDYES then
        begin
          if pclk.Connected then
          begin
            UnCallClock(pclk.hPort);
          end;
          Right := SetManagerCard(pclk.hPort, PChar(CardNo));
          for i:=0 to 2 do
          begin
            if i<>((pclk.baudrate div 9600) div 2) then
            begin
              if i=0 then InitCommPort(pclk.hPort, 9600, 255) else
                InitCommPort(pclk.hPort, i*2*9600, 255);
              Right := SetManagerCard(pclk.hPort, PChar(CardNo));
            end;
          end;
          if InitCommPort(pclk.hPort, pclk.baudrate, 255) then
          if pclk.Connected then
            ClosePort(pclk)
          else
          begin
            CloseHandle(pclk.hPort);
            pclk.hPort:=0;
          end;
        end else
        begin
          if pclk.Connected then
            ClosePort(pclk)
          else
          begin
            CloseHandle(pclk.hPort);
            pclk.hPort:=0;
          end;
        end;
        if Right then
        begin
          msg.Caption := SOK
        end
        else
        begin
          msg.Caption := SERROR;
        end;
        Windows.Beep(2500, 150);
      end else
      begin
        if pclk.Connected then
          ClosePort(pclk)
        else
        begin
          CloseHandle(pclk.hPort);
          pclk.hPort:=0;
        end;
      end;
    end;
  end;
end;

procedure TfrmMain.sbFileClick(Sender: TObject);
var
  FileName, Dir: string;
  broinfo: TBrowseInfoA;
  pidl: PITEMIDLIST;
begin
  FileName := edFileName.Text;
  if FileName='' then
    Dir := GetCurrentDir
  else
    Dir := ExtractFileDir(FileName);
  fillchar(broinfo, sizeof(TBrowseInfoA), 0);
  broinfo.hwndOwner := Handle;
  broinfo.ulFlags := BIF_BROWSEINCLUDEFILES;
  pidl := SHBrowseForFolder(broinfo);
  if pidl<>nil then
  begin
    SetLength(Dir, MAX_PATH+10);
    SHGetPathFromIDList(pidl, PChar(Dir));
    edFileName.Text := Dir;
  end;
end;

procedure TfrmMain.cbTimeReceiveClick(Sender: TObject);
var
  i: Integer;
  times: array[1..5] of TDateTime;
begin
  Times[1] := MyStrToTime(meTime1.Text);
  Times[2] := MyStrToTime(meTime2.Text);
  Times[3] := MyStrToTime(meTime3.Text);
  Times[4] := MyStrToTime(meTime4.Text);
  Times[5] := MyStrToTime(meTime5.Text);
  for i := 1 to 5 do
  begin
    if (Times[i]<>0)and(Time>=Times[i]) then
    begin
      FStarts[i] := True;
      FStartDates[i] := Date;
    end
    else
    begin
      FStarts[i] := False;
      FStartDates[i] := 0;
    end;
  end;
  Timer.Enabled := cbTimeReceive.Checked;
end;

procedure TfrmMain.btnClearDeviceListClick(Sender: TObject);

  function ClearDeviceAllListItem: Boolean;
  begin
    Result := False;
    case cbListKind.ItemIndex of
      0: {考勤白名单} Result := DeleteAllAllowedCard(pclk.hPort);
      1: {考勤黑名单} Result := DeleteAllBlackCard(pclk.hPort);
      2: {门禁通行卡} Result := DeleteAllDoorPassCard(pclk.hPort);
    end;
  end;

  function DeleteAllDevice: Boolean;
  var
    i, y: Integer;
  begin
    y := 0;
    Result := False;
    if cbUpdateAllDevice.Checked then
    begin
      Result := True;
      for i := 0 to clbDevs.Items.Count-1 do
        if clbDevs.Checked[i] then
        begin
          ClosePort(pclk);
          pclk := PClockInfo(clbDevs.Items.Objects[i]);
          if OpenPort(pclk) then
          begin
            msg.Caption := format(SOyOUUGAEeSS, [pclk.Port, pclk.clock_id]);
            msg.Update;
            Result := ClearDeviceAllListItem and Result;
            Windows.Beep(2500, 100);
            ClosePort(pclk);
            SaveListFile(CurrentListFile, cbListKind.ItemIndex, True, 2);
            Sleep(200);
          end
          else
            Result := False;
          inc(y);
        end;
    end;
    if (y=0)and(clbDevs.ItemIndex<>-1) then
    begin
      Result := False;
      pclk := PClockInfo(clbDevs.Items.Objects[clbDevs.ItemIndex]);
      if OpenPort(pclk) then
      begin
        Result := ClearDeviceAllListItem;
        SaveListFile(CurrentListFile, cbListKind.ItemIndex, True, 2);
      end;
    end;
  end;
var
  SaveCursor: TCursor;
begin
  if Assigned(Sender) and (MsgBox(Screen.ActiveForm.Handle, PChar(SECNCaYEeAGIOGAEuOGA), PChar(msg_confirm), MB_YESNO or MB_ICONQUESTION)<>IDYES) then
    Exit;
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  try
    if DeleteAllDevice or(MsgBox(Handle, PChar(SCaYEeEECNCaYEeAGI), msg_confirm, MB_YESNO or MB_ICONQUESTION)=IDYES) then
    begin
      ClearIDList(DeviceList);
      lvDeviceCards.Items.Count := DeviceList.Count;
      lvDeviceCards.Refresh;
      Windows.Beep(2500, 100);
      msg.Caption := Format(SSSAUEuOGCCAONCaY, [pclk.Port, pclk.clock_id]);
    end
    else
    begin
      Windows.Beep(2500, 100);
      msg.Caption := SCaYCCIIo;
    end;
  finally
    Screen.Cursor := SaveCursor;
    lvDeviceCards.Items.Count := DeviceList.Count;
    lvDeviceCards.Refresh;
  end;
end;

procedure TfrmMain.lbHomePageClick(Sender: TObject);
begin
  ShellExecute(Handle, 'open', PChar(TLabel(Sender).Caption), nil, nil, SW_SHOW);
end;

procedure TfrmMain.lbMailClick(Sender: TObject);
begin
  ShellExecute(Handle, 'open', PChar('mailto:'+TLabel(Sender).Caption), nil, nil, SW_SHOW);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  i, ps: Integer;
  Strs: TStringList;
  S: string;
begin
  Application.OnDeactivate:=ADeactivate;
  Screen.OnActiveFormChange:=OnActiveFormChange;
  Application.Title := SAppTitle+format(' - Ver%1.2f', [Version]);
  Caption:=Application.Title;
  lbVersion.Caption:=Application.Title;
  TrayIconData.cbSize := sizeof(TrayIconData);
  TrayIconData.Wnd := Handle;
  TrayIconData.uID := 1;
  //TrayIconData.hIcon := Icon.Handle;
  TrayIconData.hIcon := Application.Icon.Handle;
  //TrayIconData.hIcon := LoadIcon(0,IDI_APPLICATION);
  StrPCopy(@TrayIconData.szTip, PChar(Application.Title));
//    StrPCopy(@TrayIconData.szTip, SOCAUEeUIIGo);
  TrayIconData.uCallbackMessage := MYTRAY_MESSAGE;
  TrayIconData.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  //SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
  Shell_NotifyIcon(NIM_ADD, @TrayIconData);
  Application.OnMinimize := MarkTaskBarIcon;
  if FindCmdLineSwitch('n', ['-', '/'], True) then
    OnPaint := FormPaint;
  cbCardStyle.ItemIndex:=0;
  edClockType.ItemIndex := 0;
  DeviceList := TList.Create;
  PageControl1.ActivePageIndex := 0;
  cbPort.ItemIndex := 0;
  cbListKind.ItemIndex := 0;
  cbListKindChange(cbListKind);
  cbPeriodKind.ItemIndex:=0;
  FClocks := TList.Create;
  FCurrentDir := IncludeTrailingBackslash(GetCurrentDir); //目录
  FIni := TIniFile.Create(FCurrentDir+RegFile);
  Strs := TStringList.Create;
  CommPorts := GetSysCommPorts;
  cbPort.Items.Text := CommPorts;
  with FIni do
  begin
    begin
      cbCmdVerifyFirst.Checked:=ReadBool(SetSec, 'CmdVerifyFirst', cbCmdVerifyFirst.Checked);
      edFMTStr.Text := ReadString(SetSec, 'FormatString', edFMTStr.Text);
      cbUseFmt.Checked := ReadBool(SetSec, 'UseFormatString', cbUseFMT.Checked);
      rbSave.ItemIndex := ReadInteger(SetSec, 'Save', rbSave.ItemIndex);
      edFileName.Text := ReadString(SetSec, 'FileName', '');
      cbSynTime.Checked:=ReadBool(SetSec, 'Timer Update Time', cbSynTime.Checked);
      cbAutoClearClock.Checked:=ReadBool(SetSec, 'Auto Clear Device', cbAutoClearClock.Checked);
      cbTimeReceive.Checked := ReadBool(SetSec, 'Timer Receive', cbTimeReceive.Checked);
      if FindCmdLineSwitch('s', ['-', '/'], True) then cbTimeReceive.Checked :=True;
      meTime1.Text := ReadString(SetSec, 'Time1', '');
      meTime2.Text := ReadString(SetSec, 'Time2', '');
      meTime3.Text := ReadString(SetSec, 'Time3', '');
      meTime4.Text := ReadString(SetSec, 'Time4', '');
      meTime5.Text := ReadString(SetSec, 'Time5', '');
      cbNotSaveDeviceList.Checked := ReadBool(SetSec, 'Not Save Device List', cbNotSaveDeviceList.Checked);
      rgOnError.ItemIndex := ReadInteger(SetSec, 'On Error Action', rgOnError.ItemIndex);
    end;
    if cbNotSaveDeviceList.Checked then
      btnSearchClick(nil)
    else
    begin
      lvClocks.Items.BeginUpdate;
      try
        clbDevs.Clear;
        lvClocks.Items.Clear;
        ReadSectionValues(DevSec, Strs);
        for i := 0 to Strs.Count-1 do
        begin
          New(pclk);
          FillChar(pclk^, SizeOf(TClockInfo), 0);
          FClocks.Add(pclk);
          ps := Pos('=', Strs[i]);
          S := Copy(Strs[i], ps+1, Length(Strs[i])-ps);
          pclk.hPort := 0;
          pclk.Fireware := 0;
          pclk.clock_type := StrToIntDef(Copy(S, 1, 4), 0);
          pclk.Model := pclk.clock_type;
          pclk.cls := StrToIntDef(Copy(S, 5, 1), 0);
          pclk.clock_id := StrToIntDef('$'+Copy(S, 6, 2), 0);
          pclk.Port := StrToIntDef(Copy(S, 8, 4), 1);
          pclk.BaudRate := StrToIntDef(Copy(S, 12, 8), 9600);
          pclk.Fireware:=StrToFloat(Copy(S, 20, 4));
//          pclk.clock_name := Trim(Copy(S, 24, 10));
          pclk.CmdVerify:=Copy(S, 34, 1)<>'0';
          clbDevs.Items.AddObject(format(SSCOMD, [pclk.Port, pclk.clock_id]), TObject(pclk));
          with lvClocks.Items.Add do
          begin
            Data := pclk;
            Caption := IntToHex(pclk.clock_id, 2);
            SubItems.Add('');
            SubItems.Add(IntToStr(pclk.Port));
            SubItems.Add(IntToStr(pclk.BaudRate));
            if pclk.clock_type=0 then
            begin
              SubItems.Add(SOEG);
              SubItems.Add('');
            end else
            begin
              SubItems.Add(format('%d%s', [pclk.Model, arICID[pclk.cls]]));
              SubItems.Add(format('%1.2n', [pclk.Fireware]));
            end;
          end;
        end;
      finally
        lvClocks.Items.EndUpdate;
      end;
      if Strs.Count>0 then
        clbDevs.ItemIndex := 0
      else
      begin
        btnSearchClick(nil);
      end;
    end;
    if clbDevs.Items.Count=0 then
      PageControl1.ActivePage := tsClockList;
// 使用读内存
{    with lvClockTime do
    begin
      Items.Clear;
      Strs.Clear;
      ReadSectionValues(ClockerTimeSec, Strs);
      for i:=0 to Strs.Count-1 do
      begin
        S:=Strs.Values[Strs.Names[i]];
        with Items.Add do
        begin
          Caption:=Copy(S, 1, Pos(',', S)-1);
          SubItems.Add(Copy(S, Pos(',', S)+1, Length(S)));
        end;
      end;
    end;
    with lvRingTime do
    begin
      Items.Clear;
      Strs.Clear;
      ReadSectionValues(RingTimeSec, Strs);
      for i:=0 to Strs.Count-1 do
      begin
        S:=Strs.Values[Strs.Names[i]];
        with Items.Add do
        begin
          Caption:=Copy(S, 1, 2);
          SubItems.Add(Copy(S, 4, 2));
          SubItems.Add(Copy(S, 7, 2));
          SubItems.Add(Copy(S, 10, 2));
        end;
      end;
    end;}
  end;
  Strs.Free;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  Screen.OnActiveFormChange:=nil;

  TrayIconData.cbSize := SizeOf(TrayIconData);
  TrayIconData.uID := 1;
  TrayIconData.Wnd := Handle;
  //TrayIconData.uFlags := 0;
  Shell_NotifyIcon(NIM_DELETE, @TrayIconData);
  ClosePort(pclk);
  pclk := nil;
  ClearIDList(DeviceList);
  ClearIDList(FClocks);
  DeviceList.Free;
  lvClocks.Free;
  fIni.Free;
end;

procedure TfrmMain.btnOpenClick(Sender: TObject);
begin
  if FileName='' then
    ShellExecute(Handle, 'open', PChar(edFileName.Text), nil, nil, SW_SHOW)
  else
    ShellExecute(Ha