comportio.pas

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

unit ComPortIO;

interface

uses
  Windows, Messages, SysUtils;

const
  OPEN_SUCCED          = $00000000;
  OPEN_PORT_FAILE      = $00000001;
  CREATE_LINK_TIMEOUT  = $00000002;
  LINK_FAILE           = $00000003;
  COMM_PORT_INVALID    = $00000004;
  IC_CARD              = $00000005;
  ID_CARD              = $00000006;

  TIMEOUT              = 7000;
  RWTIMEOUT             = 7000;
  DLLNAME              = 'ICCtrl.Dll';

type
  TPort = Byte;

  PClockData = ^TClockData;
  TClockData = record      //Read One Record return's struct
    Card       : array [1..10]of char;
    DateTime   : array [1..12]of char;
    Flag       : char;
    Times      : array [1..3]of char;
    Banlance   : array [1..5]of char;
    Consume    : array [1..5]of char;
  end;

  PCardInfo = ^TCardInfo;
  TCardInfo = record
    CardNo : DWORD;
    Times  : DWORD;
    Money  : DWORD;
    Name   : array[1..16]of char;
  end;

  PRegCardInfo = ^TRegCardInfo;
  TRegCardInfo = record
    CardNo : array[1..10]of char;
    Name   : array[1..6]of char;
    FontData: array[1..96]of char;
  end;

  PCardCmd = ^TCardCmd;
  TCardCmd = record
    Cmd     : array [1..2]of char;
    CardNum : array [1..6]of char;
    Times   : array [1..4]of char;
    Money   : array [1..4]of char;
    Void    : array [1..2]of char;
    Name    : array [1..16]of char;
    OS      : char;
    EndSign : char;
  end;

  PRingData = ^TRingData;
  TRingData = record
    Num    : Byte;       //0-9
    Hour   : Word;       //0-23
    Min    : Word;       //0-59
    Delay  : Word;       //1-999
  end;

  PSetDateTime = ^TSetDateTime;
  TSetDateTime = record
     Year  : Word;      //4Bits
     Month : Word;      //1-12
     Day   : Word;      //1-31
     Hour  : Word;      //0-23
     Min   : Word;      //0-59
     Sec   : Word;      //0-59
  end;

  
  procedure CloseCommPort(hPort: THandle);stdcall;
  function  OpenCommPort(Port:TPort; Rate:DWORD):THandle;stdcall;
  function  LinkCommPort(hPort:THandle; ClockNo:PChar):Integer;stdcall;
  function  OpenLinkCommPort(Port:TPort; Rate:DWORD; ClockNo:PChar):THandle;stdcall;

  function  ReadDataStr(hPort:THandle; DataStr:PChar; Cmd:Byte):Boolean;stdcall;
  function  ReadClockData(hPort:THandle; Data:PClockData; Cmd:Byte):Boolean;stdcall;

  function  WriteTime(hPort:Thandle;DateTime:PSetDateTime):Boolean;stdcall;
  function  ReadTime(hPort:Thandle;Dt:PSetDateTime):Boolean;stdcall;
  function  ClearRecord(hPort:THandle):Boolean;stdcall;
  function  WriteRingTime(hPort:THandle; Ring:PRingData):Boolean;stdcall;
  function  WriteCardNo(hPort:THandle; CardNo:PChar):Boolean;stdcall;

  function  ReadCardInfo(hPort:THandle; CardInfo:PCardInfo):Boolean;stdcall;
  function  WriteCardInfo(hPort:THandle; CardInfo:PCardInfo):Boolean;stdcall;
  function  ReadCardInfoStr(hPort:THandle):String;stdcall;
  function  WriteCardInfoStr(hPort:THandle; CmdStr:String):Boolean;stdcall;

  function  WriteManagerCard(Port:TPort; Rate:DWORD; CardNo:PChar):Boolean;stdcall;
  function  ReadManagerCard(hPort:THandle; CardNo:PChar):Boolean;stdcall;
  function  WriteRegisterCard(hPort:THandle; CardNo:PChar):Boolean;stdcall;
  function  ClearRegisterCard(hPort:THandle; CardNo:PChar):Boolean;stdcall;
  function  ClearAllRegisterCard(hPort:THandle):Boolean;stdcall;
  function  ClearPassWord(Port:TPort; Rate:DWORD; PassWord:PChar):Boolean;stdcall;
  function  WritePassWord(Port:TPort; Rate:DWORD; PassWord:PChar):Boolean;stdcall;
  function  WriteEndCmd(hPort:THandle):Boolean;stdcall;
  function  ReadDevVersion(hPort:THandle;var Ver:PChar):Boolean;stdcall;
  function  ReadRecordTotal(hPort:THandle;var Total:DWORD):Boolean;stdcall;
  function  ClearTotal(hPort:THandle):Boolean;stdcall;
  function  WriteDevNo(hPort: Thandle; DevNo:PChar):Boolean;stdcall;
  function  WriteLockTime(hPort: THandle; LockTime: DWORD):Boolean;stdcall;
  function  WriteRegCardInfo(hPort: THandle; Data: PRegCardInfo):Boolean;stdcall;
  function  ClearRegCardInfo(hPort: THandle):Boolean;stdcall;
  function  ReadICCardPassWord(hPort: THandle; PassWord: PChar):Boolean;stdcall;
  function  WriteICCardPassWord(hPort: THandle; PassWord: PChar):Boolean;stdcall;

  //===================================================================
  function  WriteCmd(hPort:THandle; Cmd:PChar):Boolean;stdcall;
  function  WriteCommandWaitReturn(hPort:THandle; Cmd:PChar;ReadData:PChar):Boolean;stdcall;
  function  WaitReturnDone(hPort:THandle; Cmd:PChar):Boolean;stdcall;
  function  ReadComm(hPort:THandle; ReadData:PChar):Boolean;stdcall;
  procedure SetPortPara(hPort:THandle ; Rate:Cardinal ; ByteSize,Parity,StopBits:Byte);stdcall;

  function IntToStrLen(Value : Integer; ResultLength :Byte):String;stdcall;
  function FlipHexStr(S: String):String;stdcall;
  function StrToHex(S: String; Digits: Integer):String;stdcall;
  function HexToStr(S: String; Digits: Integer):String;stdcall;
  function QUWEIToGB(S: String):String;stdcall;
  function GBToQUWEI(S: String):String;stdcall;

  procedure FillBuf(Des,Sou:PChar;Index,MaxLen:Byte);stdcall;
  procedure DateTimeToStr(S:PChar;Dt:PSetDateTime);stdcall;

var
  lpol       : TOverlapped;
  BaudRate   : DWORD;
  Buf_Data: Array[1..100]of char;

implementation
function IntToStrLen(Value : Integer; ResultLength :Byte):String;
begin
  Result:=IntToStr(Value);
  while Length(Result) < Resultlength do
    Result:='0'+Result;
  Result:=Copy(Result, Length(Result)-ResultLength+1, ResultLength);
end;

function WriteDevNo(hPort: Thandle; DevNo:PChar):Boolean;stdcall;
var
  S: String;
begin
  S:='CX'+DevNo+'!';
  Result:=WriteCmd(hPort, PChar(S));
end;

function WriteLockTime(hPort: THandle; LockTime: DWORD):Boolean;stdcall;
var
  S: String;
begin
  Result:=False;
  if LockTime<=255 then
  begin
    S:=IntToStrLen(LockTime, 3);
    Result:=WaitReturnDone(hPort, PChar('CW'+S+'!'));
  end;
end;

function  ClearTotal(hPort:THandle):Boolean;stdcall;
begin
  Result:=WaitReturnDone(hPort,'CU!');
//  WriteEndCmd(hPort);
end;

function  ReadRecordTotal(hPort:THandle;var Total:DWORD):Boolean;stdcall;
var
  Buf   : PChar;
  I     : byte;
begin
  Total:=0;
  GetMem(Buf,11);
  try
    Result := WriteCommandWaitReturn(hPort,'CM!',Buf);
    if Result then
        for I := 0 to StrLen(Buf)-1 do
          Total:=Total*10+(DWORD(Buf[I])-48);
  //  WriteEndCmd(hPort);
  finally
    FreeMem(Buf);
  end;
end;

function  ReadDevVersion(hPort:THandle;var Ver:PChar):Boolean;stdcall;
begin
  Result := WriteCommandWaitReturn(hPort,'CK!',Ver);
//  WriteEndCmd(hPort);
end;

procedure FillBuf(Des,Sou:PChar;Index,MaxLen:Byte);
var
  I:Byte;
begin
  for I := 1 to MaxLen do begin
    Des[I]:=Sou[Index+I-2];
  end;
end;

function  WriteEndCmd(hPort:THandle):Boolean;stdcall;
begin
  SetPortPara(hPort, BaudRate, 8, 3, 0);
  Result := WriteCmd(hPort,'END!');
  Sleep(5);
end;

function  WritePassWord(Port:TPort;Rate:DWORD;PassWord:PChar):Boolean;
var
  hPort : THandle;
  Buf   : PChar;
begin
  hPort := OpenCommPort(Port,Rate);
  if (hPort <> INVALID_HANDLE_VALUE) and (StrLen(PassWord)=12) then begin 
    GetMem(Buf,20);
    try
      StrCopy(Buf,'CH');
      StrCat(Buf,PassWord);
      StrCat(Buf,'!');
      Result := WriteCmd(hPort,Buf);
      Sleep(50);
    finally
      FreeMem(Buf);
    end;
  end
  else
    Result:=False;
  CloseCommPort(hPort);
end;

function  ClearPassWord(Port:TPort;Rate:DWORD;PassWord:PChar):Boolean;
var
  hPort : THandle;
  Buf   : PChar;
begin
  hPort := OpenCommPort(Port,Rate);
  if (hPort <> INVALID_HANDLE_VALUE) and (Length(Password)=12) then begin
    GetMem(Buf,20);
    try
      StrCopy(Buf,'CG');
      StrCat(Buf,PassWord);
      StrCat(Buf,'!');
      Result := WriteCmd(hPort,Buf);
      Sleep(50);
    finally
      FreeMem(Buf);
    end;
  end
  else
    Result:=False;
  CloseCommPort(hPort);
end;

function  WriteRegisterCard(hPort:THandle; CardNo:PChar):Boolean;
var
  S: String;
begin
  S:='CQ'+CardNo+'!';
  Result := WaitReturnDone(hPort, PChar(S))
end;
function  WriteRegCardInfo(hPort: THandle; Data: PRegCardInfo):Boolean;
var
  S: String;
begin
  SetLength(S, 108);
  S:='CZ'+Data.CardNo+Data.FontData;
  Result:=WaitReturnDone(hPort, PChar(S));
end;

function  ClearRegCardInfo(hPort: THandle):Boolean;
begin
  Result:=WaitReturnDone(hPort, 'CR!');
end;

function  ClearAllRegisterCard(hPort:THandle):Boolean;stdcall;
begin
  Result:=WaitReturnDone(hPort,'CR!');
end;

function  ClearRegisterCard(hPort:THandle; CardNo:PChar):Boolean;stdcall;
var
  S: String;
begin
  S:='CP'+CardNo+'!';
  Result := WriteCmd(hPort, PChar(S))
end;

function  ReadManagerCard(hPort:THandle; CardNo:PChar):Boolean;stdcall;
begin
  SetPortPara(hPort, BaudRate, 8, 3, 0);
  Result:=WriteCommandWaitReturn(hPort, 'CV!', CardNo);
end;

function  WriteManagerCard(Port:TPort; Rate:DWORD; CardNo:PChar):Boolean;
var
  S: String;
  hPort : THandle;
begin
  Result:=False;
  hPort := OpenCommPort(Port, Rate);
  if (hPort <> INVALID_HANDLE_VALUE) then
  begin
    S:='CO'+CardNo+'!';
    if Length(S)>0 then
      Result:=WriteCmd(hPort, PChar(S));
    Sleep(50);
    CloseCommPort(hPort);
  end;
end;

function  WriteCardNo(hPort:THandle; CardNo:PChar):Boolean;
var
  S: String;
begin
  S:='CN'+CardNo+'!';
  Result := WaitReturnDone(hPort, PChar(S));
end;

function  ReadCardInfo(hPort:THandle; CardInfo:PCardInfo):Boolean;
var
  i: Integer;
  Buff, S: String;
begin
  SetLength(Buff, 100);
  CardInfo.CardNo:=0;
  CardInfo.Times:=0;
  CardInfo.Money:=0;
  for i:=1 to 8 do CardInfo.Name[i]:=chr(0);
  SetPortPara(hPort, BaudRate, 8, 4, 0);
  Result := WriteCommandWaitReturn(hPort, 'CS!', PChar(Buff));
//  Result:=True;
//  Buff:='5B1F6001000A00001322320b2f40375a';
  if Result then
  begin
    Buff[36]:=Chr(0);
    if Buff[5]='6' then
    begin
      Buff[5]:='0';
      S:=FlipHexStr(Copy(Buff, 1, 6));
      CardInfo.CardNo:=StrToInt('$'+S);
      S:=FlipHexStr(Copy(Buff, 7, 4));
      CardInfo.Times:=StrToInt('$'+S);
      S:=FlipHexStr(Copy(Buff, 11, 4));
      CardInfo.Money:=StrToInt('$'+S);
      S:=Copy(Buff, 17, 16);
      S:=HexToStr(S, 16);
      S:=QUWEIToGB(S);
      StrCopy(@CardInfo.Name, PChar(S));
      Result:=True;
    end else
      Result:=False;
  end;
end;

function  WriteCardInfo(hPort:THandle; CardInfo:PCardInfo):Boolean;
var
  i: Cardinal;
  S: TCardCmd;
  buff: String;
begin
  Result:=False;
  SetLength(Buff, 100);
  try
    if CardInfo.CardNo<99999 then
    begin
      FillChar(S, sizeof(S), '0');
      Buff:=FlipHexStr(IntToHex(CardInfo.CardNo, 6));
      StrLCopy(@S.CardNum, PChar(Buff), 6);
      Buff:=FlipHexStr(IntToHex(CardInfo.Times, 4));
      StrLCopy(@S.Times, PChar(Buff), 6);
      Buff:=FlipHexStr(IntToHex(CardInfo.Money, 4));
      StrLCopy(@S.Money, PChar(Buff), 6);

      StrLCopy(@CardInfo.Name[1], PChar(StringReplace(CardInfo.Name, #32, #0, [rfReplaceAll])), 8);
      Buff:=GBToQUWEI(PChar(@CardInfo.Name[1]));
      Buff:=StrToHex(Buff, 8);
      StrPCopy(@S.Name, Buff);
      for i:=StrLen(@CardInfo.Name[1]) div 2 to 3 do
      begin
        StrCopy(@S.Name[i*4+1], '375A');
      end;
      S.Cmd:='CT';
      S.CardNum[5]:='6';
      S.Void:='00';
      S.OS:='!';
      S.EndSign:=#0;
      Result := WaitReturnDone(hPort, PChar(@S));
    end;
  finally
  end;
end;

function  WriteCardInfoStr(hPort:THandle; CmdStr:String):Boolean;
var
  Buff: String;
begin
  Result:=False;
  if Length(CmdStr)=32 then
  begin
    Buff:='CT'+CmdStr+'!';
    Result := WaitReturnDone(hPort, PChar(Buff));
  end;
end;

function  ReadCardInfoStr(hPort:THandle):String;
var
  Right: Boolean;
  Buff: PChar;
begin
  GetMem(Buff, 36);
  try
    Right := WriteCommandWaitReturn(hPort, 'CS!', Buff);
    if Right then
       Result:=Buff;
  finally
    FreeMem(Buff);
  end;
end;

function  WriteCmd(hPort:THandle; Cmd:PChar):Boolean;
var
  NUM : DWORD;
begin
  PurgeComm(hPort,PURGE_RXCLEAR);
  PurgeComm(hPort,PURGE_TXABORT);
  PurgeComm(hPort,PURGE_TXCLEAR);

  Num := 0;
  if lpol.hEvent=0 then
    lpol.hEvent := CreateEvent(nil,true,true,nil);

  StrLCopy(@Buf_Data[1], Cmd, StrLen(Cmd));
  ResetEvent(lpol.hEvent);
  Result := WriteFile(hPort, Buf_Data, Length(Cmd), Num, @lpol);
  if (GetLastError() = ERROR_IO_PENDING) then
    Result := WaitForSingleObject(lpol.hEvent, RWTIMEOUT) = WAIT_OBJECT_0;
end;

function  WaitReturnDone(hPort:THandle;Cmd:PChar):Boolean;
var