comportio.pas

IC卡饭堂售饭管理系统源码,内有相关说明,

  Buf  :PChar;
  Right:Boolean;
begin
  GetMem(Buf,10);
  try
    Right := WriteCommandWaitReturn(hPort,Cmd,Buf);
    Sleep(5);
    if Right then
       Right := StrPos(Buf,'DONE')<>nil;
  finally
    FreeMem(Buf);
  end;
  Result := Right;
end;

function  WriteRingTime(hPort:THandle;Ring:PRingData):Boolean;
var
  S:PChar;
begin
  GetMem(S,12);
  try
    StrCopy(S,'CI00000000!');
    S[3]:=chr(Ring.Num+48);
    if Ring.Min>9 then S[4]:=chr(Ring.Min div 10+48);
    S[5]:=chr(Ring.Min mod 10+48);

    if Ring.Hour>9 then S[6]:=chr(Ring.Min div 10+48);
    S[7]:=chr(Ring.Hour mod 10+48);

    if Ring.Delay>99 then S[8]:=chr(Ring.Delay div 100+48);
    if (Ring.Delay mod 100)>9 then S[9]:=chr((Ring.Delay mod 100) div 10+48);
    S[10]:=chr(Ring.Delay mod 10+48);
    S[11]:='!';
//    Result := WaitReturnDone(hPort,S);
    Result := WriteCmd(hPort, S);
    Sleep(50);
  finally
    FreeMem(S);
  end;
//  WriteEndCmd(hPort);
end;

function  ClearRecord(hPort:THandle):Boolean;
begin
  Result := WaitReturnDone(hPort,'CJ!');
//  WriteEndCmd(hPort);
end;
{*      黍嗣跺趼睫彻最*}
function  ReadComm(hPort:THandle; ReadData:PChar):Boolean;stdcall;
var
  St,NUM : DWORD;
  Right : Boolean;
  Signal: Integer;
  lpErrors: Cardinal;
  Coms: TComStat;
  pEvtMask: Cardinal;
begin
  Result:=False;
  pEvtMask:=EV_RXCHAR;
  Signal:=0;
  Num   := 0;
  if lpol.hEvent=0 then
    lpol.hEvent := CreateEvent(nil,true,true,nil);
  St := GetTickCount();
  ReadData^:=#0;
  while true do
  begin
    WaitCommEvent(hPort, pEvtMask, @lpol);
    if ClearCommError(hPort, lpErrors, @Coms) then
    if Coms.cbInQue>0 then
    begin
        FillChar(Buf_Data, Sizeof(Buf_Data), 0);
        ResetEvent(hPort);
        Right:=ReadFile(hPort, Buf_Data, Coms.cbInQue, Num, @lpol);
        Right:=Right and (Num=Coms.cbInQue);
        if not Right then Continue;

        if (GetLastError() = ERROR_IO_PENDING) then
          Signal := WaitForSingleObject(lpol.hEvent, RWTIMEOUT);

//        Right:=Signal = WAIT_OBJECT_0;
        if Signal= WAIT_TIMEOUT then
          SetCommMask(hPort, 0); // timeout ellapsed, stop WaitCommEvent function

        StrCat(ReadData, @Buf_Data);
        StrCat(ReadData, #0);
        if StrPos(@Buf_Data, '!')<>nil then
        begin
          StrPos(ReadData, '!')^:=#0;
          Result:=True;
          Break;
        end;
    end;
    if GetTickCount()-St>RWTIMEOUT then
    begin
      Result := False;
      break;
    end;
  end;
end;

function  WriteCommandWaitReturn(hPort:THandle;Cmd:PChar;ReadData:PChar):Boolean;
var
  Right : Boolean;
begin
  Right := WriteCmd(hPort,Cmd);
  if Right then
  begin
    Right := ReadComm(hPort,ReadData);
  end;
  Result := Right;
end;

function  ReadTime(hPort:Thandle;Dt:PSetDateTime):Boolean;
var
  Buf  :PChar;
  Right:Boolean;
begin
GetMem(Buf,20);
try
  Right := WriteCommandWaitReturn(hPort,'CC!',Buf);
  Result := false;
//  WriteEndCmd(hPort);
  if Right then begin
      if Right and(StrLen(Buf)=14) then  begin
         Dt.Year  := (Ord(Buf[0])-48)*1000+(Ord(Buf[1])-48)*100+(Ord(Buf[2])-48)*10+Ord(Buf[3])-48;
         Dt.Month := (Ord(Buf[4])-48)*10+Ord(Buf[5])-48;
         Dt.Day   := (Ord(Buf[6])-48)*10+Ord(Buf[7])-48;
         Dt.Hour  := (Ord(Buf[8])-48)*10+Ord(Buf[9])-48;
         Dt.Min   := (Ord(Buf[10])-48)*10+Ord(Buf[11])-48;
         Dt.Sec   := (Ord(Buf[12])-48)*10+Ord(Buf[13])-48;
         Result:=True;
      end else if Right and (StrLen(Buf)=12) then
      begin
         Dt.Year  := 2000+(Ord(Buf[0])-48)*10+Ord(Buf[1])-48;
         Dt.Month := (Ord(Buf[2])-48)*10+Ord(Buf[3])-48;
         Dt.Day   := (Ord(Buf[4])-48)*10+Ord(Buf[5])-48;
         Dt.Hour  := (Ord(Buf[6])-48)*10+Ord(Buf[7])-48;
         Dt.Min   := (Ord(Buf[8])-48)*10+Ord(Buf[9])-48;
         Dt.Sec   := (Ord(Buf[10])-48)*10+Ord(Buf[11])-48;
         Result:=True;
      end;
  end;
finally
  FreeMem(Buf);
end;
end;

procedure DateTimeToStr(S:PChar;Dt:PSetDateTime);stdcall;
begin
  StrFmt(S, 'CD%04u%02u%02u%02u%02u!', [DT.year, DT.Month, DT.Day, DT.Hour, DT.Min]);
end;

function  WriteTime(hPort:Thandle;DateTime:PSetDateTime):Boolean;
var
  S : PChar;
begin
  GetMem(S,16);
  try
    DateTimeToStr(S,DateTime);
    S[1]:='D';
    Result := WaitReturnDone(hPort,S);
  finally
    FreeMem(S);
  end;
//  WriteEndCmd(hPort);
end;

function ReadDataStr(hPort : THandle; DataStr : PChar; Cmd: Byte):Boolean;
begin
    if Cmd=1 then
       Result := WriteCommandWaitReturn(hPort,'CA!', DataStr)
    else
       Result := WriteCommandWaitReturn(hPort,'CB!', DataStr);
end;

function ReadClockData(hPort : THandle; Data: PClockData; Cmd: Byte):Boolean;stdcall;
var
  I: Integer;
  Right: Boolean;
  Buff, str: String;
begin
  Result:=False;
  SetLength(Buff, 100);
    if Cmd=1 then
       Right := WriteCommandWaitReturn(hPort,'CA!', PChar(Buff))
    else
       Right := WriteCommandWaitReturn(hPort,'CB!', PChar(Buff));
  if Right then
  begin
    SetLength(Buff, StrLen(PChar(Buff)));
    StrLCopy(@Data.Card, PChar(Buff), 10);
    if Pos('OVER', Buff)=0 then
    begin
         if Length(Buff)>16 then
         begin
              if Length(Buff)>27 then
              begin
                Data.DateTime[1]:='2';
                Data.DateTime[2]:='0';
                for i := 1 to 12 do Data.DateTime[i+2]:=Buff[I];
                for I := 1 to 5 do Data.Card[I]:=Buff[I+10];
                Data.Flag:='0';
                str:=Copy(PChar(Buff), 16, 3);
                move(str, Data.Times, 3);
                str:=Copy(Buff, 19, 5);
                move(str, Data.Banlance, 5);
                str:=Copy(Buff, 24, 5);
                move(str, Data.Consume, 5);
              end else
              begin
                Data.DateTime[1]:='2';
                Data.DateTime[2]:='0';
                for i := 1 to 12 do Data.DateTime[i+2]:=Buff[I];
                for I := 1 to 10 do Data.Card[I]:=Buff[I+11];
                Data.Flag:=Buff[11];
              end;
           end
           else begin
                Data.DateTime[1]:='2';
                Data.DateTime[2]:='0';
                for i := 1 to 12 do Data.DateTime[i+2]:=Buff[I];
                for I := 1 to 5 do Data.Card[I]:=Buff[I+11];
                for I := 6 to 10 do Data.Card[I]:=#0;
                Data.Flag:=Buff[11];
           end;
    end;
    Result:=True;
  end;
end;

procedure SetPortPara(hPort:THandle ; Rate:Cardinal ; ByteSize,Parity,StopBits:Byte);
var
  pDcb : TDcb;
begin
  GetCommState(hPort,pDcb);
  if Rate>0 then
    pDcb.BaudRate := Rate;
  if (ByteSize>=4) and (ByteSize<=8) then
    pDcb.ByteSize := ByteSize;
  if Parity<=4 then
    pDcb.Parity := Parity;
  if StopBits<=3 then
    pDcb.StopBits := StopBits;
  SetCommState(hPort, pDcb);
end;

procedure CloseCommPort(hPort:THandle);
begin
  if (hPort <> INVALID_HANDLE_VALUE) and (hPort <> 0) then
  begin
    FlushFileBuffers(hPort);
    PurgeComm(hPort,PURGE_TXCLEAR);
    PurgeComm(hPort,PURGE_TXABORT);
    PurgeComm(hPort,PURGE_RXCLEAR);
    PurgeComm(hPort,PURGE_RXABORT);
    WriteEndCmd(hPort);
    CloseHandle(hPort);
  end;
end;

function OpenCommPort(Port:TPort; Rate:DWORD):THandle;
var
  S  : String;
  TOut: TCOMMTIMEOUTS;
begin
    BaudRate := Rate;
    S:='COM'+IntToStr(Port);
    Result := CreateFile(PChar(S), GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
    0);
    if Result<>INVALID_HANDLE_VALUE then
    begin
      FillChar(lpol, sizeof(TOverlapped), 0);
      lpol.hEvent := CreateEvent(nil,true,true,nil);
      SetPortPara(Result, BaudRate, 8, 3, 0);
      FillChar(TOut, SizeOf(TCOMMTIMEOUTS),0);
      TOut.ReadIntervalTimeout := TIMEOUT;
      SetCommTimeOuts(Result, TOut);         //Set Timeout values
    end;
end;

function  LinkCommPort(hPort:THandle; ClockNo:PChar):Integer;
var
  St      : DWORD;
  Right   : Boolean;
  S: String;
begin
  if (hPort <> INVALID_HANDLE_VALUE) and (hPort <> 0) then
  begin
    S:=Format('CALL%02s!', [ClockNo]);
    Right := WriteCmd(hPort, PChar(S));
    Sleep(150);
    if Right then
    begin
      St := GetTickCount();
      Right := ReadComm(hPort, @Buf_Data);
      if (not Right) and (GetTickCount()-ST>=TIMEOUT) then
        Result := CREATE_LINK_TIMEOUT
      else
      begin
        if not Right then Result := LINK_FAILE
        else
          if (StrPos(@Buf_Data,'#OK')<>nil) or (StrPos(@Buf_Data,'OVER')<>nil) then
            Result := OPEN_SUCCED
          else
            Result := LINK_FAILE;
      end;
    end else
      Result := LINK_FAILE;
  end else
    Result := COMM_PORT_INVALID;

  if Result=OPEN_SUCCED
    then SetPortPara(hPort,BaudRate, 8, 4, 0);
end;

function OpenLinkCommPort(Port:TPort; Rate:DWORD; ClockNo:PChar):THandle;
begin
  Result:=OpenCommPort(Port, Rate);
  if LinkCommPort(Result, ClockNo)<>OPEN_SUCCED then
  begin
    if (Result<>INVALID_HANDLE_VALUE)and(Result<>0) then
    begin
       CloseCommPort(Result);
       Result:=0;
    end;
  end;
end;

function ReadICCardPassWord(hPort: THandle; PassWord: PChar):Boolean;
begin
  Result:=False;
  if Assigned(Password) then
  begin
    Result:=WriteCommandWaitReturn(hPort, 'ES!', PassWord);
  end;
end;

function WriteICCardPassWord(hPort: THandle; PassWord: PChar):Boolean;
var
  S: String;
begin
  Result:=False;
  if Assigned(PassWord) then
  begin
    S:='ET'+PassWord+'!';
    if Length(S)=35 then
      Result:=WaitReturnDone(hPort, PChar(S));
  end;
end;

function FlipHexStr(S: String):String;
var
  i: Integer;
begin
  Result:='';
  for i:=Length(S) div 2 downto 1 do
  begin
    Result:=Result+Copy(S, i*2-1, 2);
  end;
end;

function StrToHex(S: String; Digits: Integer):String;
var
  i, nSize: Integer;
  S1: String;
begin
//  Result:='';
  nSize:=Length(S);
  if Digits>nSize then Digits:=nSize;
  for i:=1 to Digits do
    S1:=S1+IntToHex(Ord(S[i]), 2);
  Result:=S1;
end;

function HexToStr(S: String; Digits: Integer): String;
var
  i, nSize: Integer;
  S1: String;
begin
//  Result:='';
  nSize:=Length(S);
  if Digits>nSize then Digits:=nSize;
  for i:=1 to Digits div 2 do
    S1:=S1+Chr(StrToIntDef('$'+Copy(S, i*2-1, 2), 0));
  Result:=S1;
end;

function GBtoQUWEI(S: String): String;
var
  I : Integer;
  Char1, Char2: Byte;
begin
  Result:='';
  for I:=1 to Length(S) div 2 do
  begin
    Char1:=Ord(S[2*i-1]);
    Char2:=Ord(S[2*i]);
    if (Char1 > $A0)and(Char2 > $A0) then
    begin
      if (Char1=$A1)and(Char2=$A1) then
      begin
        Char1:=$37;
        Char2:=$5A;
      end else
      begin
        Char1:=Char1-$A0;
        Char2:=Char2-$A0;
      end;
    end;
    Result:=Result+Chr(Char1);
    Result:=Result+Chr(Char2);
  end;
end;

function QUWEIToGB(S: String):String;
var
  i : Integer;
  Char1, Char2: Byte;
begin
  Result:='';
  for i:=1 to Length(S) div 2 do
  begin
    Char1:=ord(S[2*i-1]);
    Char2:=ord(S[2*i]);
    begin
      if (Char1=$37)and(Char2=$5A) then
      begin
        Char1:=$A1;
        Char2:=$A1;
      end else
      begin
        Char1:=Char1+$A0;
        Char2:=Char2+$A0;
      end;
    end;
    Result:=Result+Chr(Char1);
    Result:=Result+Chr(Char2);
  end;
end;

end.